removing withGHCDummyFile.
This commit is contained in:
		
							parent
							
								
									b9d4b9b66f
								
							
						
					
					
						commit
						79946f9a3d
					
				| @ -31,7 +31,7 @@ browseModule :: Options | |||||||
|              -> Cradle |              -> Cradle | ||||||
|              -> ModuleString -- ^ A module name. (e.g. \"Data.List\") |              -> ModuleString -- ^ A module name. (e.g. \"Data.List\") | ||||||
|              -> IO String |              -> IO String | ||||||
| browseModule opt cradle mdlName = withGHCDummyFile $ do | browseModule opt cradle mdlName = withGHC' $ do | ||||||
|     void $ initializeFlagsWithCradle opt cradle [] False |     void $ initializeFlagsWithCradle opt cradle [] False | ||||||
|     browse opt mdlName |     browse opt mdlName | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -2,7 +2,7 @@ | |||||||
| 
 | 
 | ||||||
| module Language.Haskell.GhcMod.GHCApi ( | module Language.Haskell.GhcMod.GHCApi ( | ||||||
|     withGHC |     withGHC | ||||||
|   , withGHCDummyFile |   , withGHC' | ||||||
|   , initializeFlagsWithCradle |   , initializeFlagsWithCradle | ||||||
|   , setTargetFiles |   , setTargetFiles | ||||||
|   , addTargetFiles |   , 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. | -- | Converting the 'Ghc' monad to the 'IO' monad. | ||||||
| withGHC :: FilePath  -- ^ A target file displayed in an error message. | withGHC :: FilePath  -- ^ A target file displayed in an error message. | ||||||
|         -> Ghc a -- ^ 'Ghc' actions created by the Ghc utilities. |         -> Ghc a -- ^ 'Ghc' actions created by the Ghc utilities. | ||||||
|         -> IO a |         -> IO a | ||||||
| withGHC file body = do | withGHC file body = ghandle ignore $ withGHC' body | ||||||
|     mlibdir <- getSystemLibDir |  | ||||||
|     ghandle ignore $ G.runGhc mlibdir $ do |  | ||||||
|         dflags <- G.getSessionDynFlags |  | ||||||
|         G.defaultCleanupHandler dflags body |  | ||||||
|   where |   where | ||||||
|     ignore :: SomeException -> IO a |     ignore :: SomeException -> IO a | ||||||
|     ignore e = do |     ignore e = do | ||||||
| @ -63,6 +54,13 @@ withGHC file body = do | |||||||
|         hPrint stderr e |         hPrint stderr e | ||||||
|         exitSuccess |         exitSuccess | ||||||
| 
 | 
 | ||||||
|  | withGHC' :: Ghc a -> IO a | ||||||
|  | withGHC' body = do | ||||||
|  |     mlibdir <- getSystemLibDir | ||||||
|  |     G.runGhc mlibdir $ do | ||||||
|  |         dflags <- G.getSessionDynFlags | ||||||
|  |         G.defaultCleanupHandler dflags body | ||||||
|  | 
 | ||||||
| ---------------------------------------------------------------- | ---------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
| importDirs :: [IncludeDir] | importDirs :: [IncludeDir] | ||||||
|  | |||||||
| @ -1,7 +1,7 @@ | |||||||
| module Language.Haskell.GhcMod.Ghc ( | module Language.Haskell.GhcMod.Ghc ( | ||||||
|   -- * Converting the 'Ghc' monad to the 'IO' monad |   -- * Converting the 'Ghc' monad to the 'IO' monad | ||||||
|     withGHC |     withGHC | ||||||
|   , withGHCDummyFile |   , withGHC' | ||||||
|   -- * 'Ghc' utilities |   -- * 'Ghc' utilities | ||||||
|   , browse |   , browse | ||||||
|   , check |   , check | ||||||
|  | |||||||
| @ -37,19 +37,22 @@ infoExpr :: Options | |||||||
|          -> FilePath     -- ^ A target file. |          -> FilePath     -- ^ A target file. | ||||||
|          -> Expression   -- ^ A Haskell expression. |          -> Expression   -- ^ A Haskell expression. | ||||||
|          -> IO String |          -> IO String | ||||||
| infoExpr opt cradle file expr = (++ "\n") <$> withGHCDummyFile | infoExpr opt cradle file expr = withGHC' $ | ||||||
|     (inModuleContext opt cradle file (info opt file expr) "Cannot show info") |     inModuleContext opt cradle file (info opt file expr) | ||||||
| 
 | 
 | ||||||
| -- | Obtaining information of a target expression. (GHCi's info:) | -- | Obtaining information of a target expression. (GHCi's info:) | ||||||
| info :: Options | info :: Options | ||||||
|      -> FilePath     -- ^ A target file. |      -> FilePath     -- ^ A target file. | ||||||
|      -> Expression   -- ^ A Haskell expression. |      -> Expression   -- ^ A Haskell expression. | ||||||
|      -> Ghc String |      -> Ghc String | ||||||
| info opt file expr = do | info opt file expr = convert opt <$> ghandle handler body | ||||||
|  |   where | ||||||
|  |     body = do | ||||||
|         void $ Gap.setCtx file |         void $ Gap.setCtx file | ||||||
|         sdoc <- Gap.infoThing expr |         sdoc <- Gap.infoThing expr | ||||||
|         (dflag, style) <- getFlagStyle |         (dflag, style) <- getFlagStyle | ||||||
|     return $ convert opt $ showPage dflag style sdoc |         return $ showPage dflag style sdoc | ||||||
|  |     handler (SomeException e) = return $ "Cannot show info (" ++ show e ++ ")" | ||||||
| 
 | 
 | ||||||
| ---------------------------------------------------------------- | ---------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
| @ -71,10 +74,8 @@ typeExpr :: Options | |||||||
|          -> Int          -- ^ Line number. |          -> Int          -- ^ Line number. | ||||||
|          -> Int          -- ^ Column number. |          -> Int          -- ^ Column number. | ||||||
|          -> IO String |          -> IO String | ||||||
| typeExpr opt cradle file lineNo colNo = withGHCDummyFile $ | typeExpr opt cradle file lineNo colNo = withGHC' $ | ||||||
|     inModuleContext opt cradle file (types opt file lineNo colNo) errmsg |     inModuleContext opt cradle file (types opt file lineNo colNo) | ||||||
|   where |  | ||||||
|     errmsg = convert opt ([] :: [((Int,Int,Int,Int),String)]) |  | ||||||
| 
 | 
 | ||||||
| -- | Obtaining type of a target expression. (GHCi's type:) | -- | Obtaining type of a target expression. (GHCi's type:) | ||||||
| types :: Options | types :: Options | ||||||
| @ -82,12 +83,16 @@ types :: Options | |||||||
|       -> Int          -- ^ Line number. |       -> Int          -- ^ Line number. | ||||||
|       -> Int          -- ^ Column number. |       -> Int          -- ^ Column number. | ||||||
|       -> Ghc String |       -> Ghc String | ||||||
| types opt file lineNo colNo = do | types opt file lineNo colNo = convert opt <$> ghandle handler body | ||||||
|  |   where | ||||||
|  |     body = do | ||||||
|         modSum <- Gap.setCtx file |         modSum <- Gap.setCtx file | ||||||
|         (dflag, style) <- getFlagStyle |         (dflag, style) <- getFlagStyle | ||||||
|         srcSpanTypes <- getSrcSpanType modSum lineNo colNo |         srcSpanTypes <- getSrcSpanType modSum lineNo colNo | ||||||
|         let tups = map (toTup dflag style) $ sortBy (cmp `on` fst) srcSpanTypes |         let tups = map (toTup dflag style) $ sortBy (cmp `on` fst) srcSpanTypes | ||||||
|     return $ convert opt tups |         return $ tups | ||||||
|  |     handler (SomeException _) = return errmsg | ||||||
|  |     errmsg = [] :: [((Int,Int,Int,Int),String)] | ||||||
| 
 | 
 | ||||||
| getSrcSpanType :: G.ModSummary -> Int -> Int -> Ghc [(SrcSpan, Type)] | getSrcSpanType :: G.ModSummary -> Int -> Int -> Ghc [(SrcSpan, Type)] | ||||||
| getSrcSpanType modSum lineNo colNo = do | getSrcSpanType modSum lineNo colNo = do | ||||||
| @ -129,14 +134,12 @@ pretty dflag style = showOneLine dflag style . Gap.typeForUser | |||||||
| noWaringOptions :: [String] | noWaringOptions :: [String] | ||||||
| noWaringOptions = ["-w:"] | noWaringOptions = ["-w:"] | ||||||
| 
 | 
 | ||||||
| inModuleContext :: Options -> Cradle -> FilePath -> Ghc String -> String -> Ghc String | inModuleContext :: Options -> Cradle -> FilePath -> Ghc String -> Ghc String | ||||||
| inModuleContext opt cradle file action errmsg = ghandle handler $ do | inModuleContext opt cradle file action = do | ||||||
|     void $ initializeFlagsWithCradle opt cradle noWaringOptions False |     void $ initializeFlagsWithCradle opt cradle noWaringOptions False | ||||||
|     setTargetFiles [file] |     setTargetFiles [file] | ||||||
|     void $ G.load LoadAllTargets |     void $ G.load LoadAllTargets | ||||||
|     action |     action | ||||||
|  where |  | ||||||
|    handler (SomeException _) = return errmsg |  | ||||||
| 
 | 
 | ||||||
| ---------------------------------------------------------------- | ---------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -14,7 +14,7 @@ import UniqFM (eltsUFM) | |||||||
| 
 | 
 | ||||||
| -- | Listing installed modules. | -- | Listing installed modules. | ||||||
| listModules :: Options -> Cradle -> IO String | listModules :: Options -> Cradle -> IO String | ||||||
| listModules opt cradle = withGHCDummyFile $ do | listModules opt cradle = withGHC' $ do | ||||||
|     void $ initializeFlagsWithCradle opt cradle [] False |     void $ initializeFlagsWithCradle opt cradle [] False | ||||||
|     modules opt |     modules opt | ||||||
| 
 | 
 | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user
	 Kazu Yamamoto
						Kazu Yamamoto