refactoring.

This commit is contained in:
Kazu Yamamoto 2014-04-26 23:03:50 +09:00
parent 98d3c7028c
commit 64365807f9

View File

@ -9,7 +9,6 @@ module Language.Haskell.GhcMod.Info (
) where ) where
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Control.Monad (void)
import CoreMonad (liftIO) import CoreMonad (liftIO)
import CoreUtils (exprType) import CoreUtils (exprType)
import Data.Function (on) import Data.Function (on)
@ -48,10 +47,8 @@ info :: Options
-> Ghc String -> Ghc String
info opt file expr = convert opt <$> ghandle handler body info opt file expr = convert opt <$> ghandle handler body
where where
body = inModuleContext file $ do body = inModuleContext file $ \_ dflag style -> do
void $ Gap.setCtx file
sdoc <- Gap.infoThing expr sdoc <- Gap.infoThing expr
(dflag, style) <- getFlagStyle
return $ showPage dflag style sdoc return $ showPage dflag style sdoc
handler (SomeException _) = return "Cannot show info" handler (SomeException _) = return "Cannot show info"
@ -87,12 +84,9 @@ types :: Options
-> Ghc String -> Ghc String
types opt file lineNo colNo = convert opt <$> ghandle handler body types opt file lineNo colNo = convert opt <$> ghandle handler body
where where
body = inModuleContext file $ do body = inModuleContext file $ \modSum dflag style -> do
modSum <- Gap.setCtx file
(dflag, style) <- getFlagStyle
srcSpanTypes <- getSrcSpanType modSum lineNo colNo srcSpanTypes <- getSrcSpanType modSum lineNo colNo
let tups = map (toTup dflag style) $ sortBy (cmp `on` fst) srcSpanTypes return $ map (toTup dflag style) $ sortBy (cmp `on` fst) srcSpanTypes
return tups
handler (SomeException _) = return [] handler (SomeException _) = return []
getSrcSpanType :: G.ModSummary -> Int -> Int -> Ghc [(SrcSpan, Type)] getSrcSpanType :: G.ModSummary -> Int -> Int -> Ghc [(SrcSpan, Type)]
@ -132,15 +126,10 @@ pretty dflag style = showOneLine dflag style . Gap.typeForUser
---------------------------------------------------------------- ----------------------------------------------------------------
inModuleContext :: FilePath -> Ghc a -> Ghc a inModuleContext :: FilePath -> (G.ModSummary -> DynFlags -> PprStyle -> Ghc a) -> Ghc a
inModuleContext file action = withDynFlags setDeferTypeErrors $ do inModuleContext file action = withDynFlags setDeferTypeErrors $ do
setTargetFiles [file] setTargetFiles [file]
action modSum <- Gap.setCtx file
----------------------------------------------------------------
getFlagStyle :: Ghc (DynFlags, PprStyle)
getFlagStyle = do
dflag <- G.getSessionDynFlags dflag <- G.getSessionDynFlags
style <- getStyle style <- getStyle
return (dflag, style) action modSum dflag style