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

clarifying Ghc and IO.

Browse Source
This commit is contained in:
Kazu Yamamoto 2014-04-11 13:14:45 +09:00
parent 998a43ce24
commit a0d559de61
1 changed files with 22 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
Language/Haskell/GhcMod/Info.hs
View File

@ -37,22 +37,19 @@ 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 (info opt cradle file expr) infoExpr opt cradle file expr = (++ "\n") <$> withGHCDummyFile
(inModuleContext opt cradle file (info file expr) "Cannot show info")
-- | Obtaining information of a target expression. (GHCi's info:) -- | Obtaining information of a target expression. (GHCi's info:)
info :: Options info :: FilePath -- ^ A target file.
-> Cradle
-> FilePath -- ^ A target file.
-> Expression -- ^ A Haskell expression. -> Expression -- ^ A Haskell expression.
-> Ghc String -> Ghc String
info opt cradle file expr = info file expr = do
inModuleContext opt cradle file exprToInfo "Cannot show info" void $ Gap.setCtx file
where sdoc <- Gap.infoThing expr
exprToInfo _ = do dflag <- G.getSessionDynFlags
sdoc <- Gap.infoThing expr style <- getStyle
dflag <- G.getSessionDynFlags return $ showPage dflag style sdoc
style <- getStyle
return $ showPage dflag style sdoc
---------------------------------------------------------------- ----------------------------------------------------------------
@ -74,26 +71,24 @@ 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 $ typeOf opt cradle file lineNo colNo typeExpr opt cradle file lineNo colNo = withGHCDummyFile $
inModuleContext opt cradle file (typeOf opt file lineNo colNo) errmsg
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:)
typeOf :: Options typeOf :: Options
-> Cradle
-> FilePath -- ^ A target file. -> FilePath -- ^ A target file.
-> Int -- ^ Line number. -> Int -- ^ Line number.
-> Int -- ^ Column number. -> Int -- ^ Column number.
-> Ghc String -> Ghc String
typeOf opt cradle file lineNo colNo = typeOf opt file lineNo colNo = do
inModuleContext opt cradle file exprToType errmsg modSum <- Gap.setCtx file
where srcSpanTypes <- getSrcSpanType modSum lineNo colNo
exprToType modSum = do dflag <- G.getSessionDynFlags
srcSpanTypes <- getSrcSpanType modSum lineNo colNo style <- getStyle
dflag <- G.getSessionDynFlags let tups = map (toTup dflag style) $ sortBy (cmp `on` fst) srcSpanTypes
style <- getStyle return $ convert opt tups
let tups = map (toTup dflag style) $ sortBy (cmp `on` fst) srcSpanTypes
return $ convert opt tups
errmsg = convert opt ([] :: [((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
@ -135,11 +130,11 @@ pretty dflag style = showOneLine dflag style . Gap.typeForUser
noWaringOptions :: [String] noWaringOptions :: [String]
noWaringOptions = ["-w:"] noWaringOptions = ["-w:"]
inModuleContext :: Options -> Cradle -> FilePath -> (G.ModSummary -> Ghc String) -> String -> Ghc String inModuleContext :: Options -> Cradle -> FilePath -> Ghc String -> String -> Ghc String
inModuleContext opt cradle file action errmsg = ghandle handler $ do inModuleContext opt cradle file action errmsg = ghandle handler $ 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
Gap.setCtx file >>= action action
where where
handler (SomeException _) = return errmsg handler (SomeException _) = return errmsg