close import.

This commit is contained in:
Kazu Yamamoto 2014-03-27 15:56:14 +09:00
parent f24749b13b
commit ff70313049
2 changed files with 27 additions and 26 deletions

View File

@ -19,14 +19,15 @@ import Data.List (sortBy)
import Data.Maybe (catMaybes, fromMaybe, listToMaybe) import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
import Data.Ord as O import Data.Ord as O
import Data.Time.Clock (getCurrentTime) import Data.Time.Clock (getCurrentTime)
import GHC import GHC (Ghc, LHsBind, LHsExpr, LPat, Id, TypecheckedModule(..), DynFlags, SrcSpan, Type, Located, TypecheckedSource, GenLocated(L), LoadHowMuch(..), TargetId(..))
import qualified GHC as G
import GHC.SYB.Utils (Stage(TypeChecker), everythingStaged) import GHC.SYB.Utils (Stage(TypeChecker), everythingStaged)
import HscTypes (ms_imps) import HscTypes (ms_imps)
import Language.Haskell.GhcMod.Doc (showUnqualifiedPage, showUnqualifiedOneLine, showQualifiedPage) import Language.Haskell.GhcMod.Doc (showUnqualifiedPage, showUnqualifiedOneLine, showQualifiedPage)
import Language.Haskell.GhcMod.GHCApi import Language.Haskell.GhcMod.GHCApi
import Language.Haskell.GhcMod.GHCChoice ((||>), goNext) import Language.Haskell.GhcMod.GHCChoice ((||>), goNext)
import qualified Language.Haskell.GhcMod.Gap as Gap
import Language.Haskell.GhcMod.Gap (HasType(..)) import Language.Haskell.GhcMod.Gap (HasType(..))
import qualified Language.Haskell.GhcMod.Gap as Gap
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
import Outputable (ppr) import Outputable (ppr)
import TcHsSyn (hsPatType) import TcHsSyn (hsPatType)
@ -57,7 +58,7 @@ info opt cradle file modstr expr =
inModuleContext Info opt cradle file modstr exprToInfo "Cannot show info" inModuleContext Info opt cradle file modstr exprToInfo "Cannot show info"
where where
exprToInfo = do exprToInfo = do
dflag <- getSessionDynFlags dflag <- G.getSessionDynFlags
sdoc <- Gap.infoThing expr sdoc <- Gap.infoThing expr
return $ showUnqualifiedPage dflag sdoc return $ showUnqualifiedPage dflag sdoc
@ -65,12 +66,12 @@ info opt cradle file modstr expr =
instance HasType (LHsExpr Id) where instance HasType (LHsExpr Id) where
getType tcm e = do getType tcm e = do
hs_env <- getSession hs_env <- G.getSession
mbe <- liftIO $ Gap.deSugar tcm e hs_env mbe <- liftIO $ Gap.deSugar tcm e hs_env
return $ (getLoc e, ) <$> CoreUtils.exprType <$> mbe return $ (G.getLoc e, ) <$> CoreUtils.exprType <$> mbe
instance HasType (LPat Id) where instance HasType (LPat Id) where
getType _ (L spn pat) = return $ Just (spn, hsPatType pat) getType _ (G.L spn pat) = return $ Just (spn, hsPatType pat)
---------------------------------------------------------------- ----------------------------------------------------------------
@ -96,16 +97,16 @@ typeOf opt cradle file modstr lineNo colNo =
inModuleContext Type opt cradle file modstr exprToType errmsg inModuleContext Type opt cradle file modstr exprToType errmsg
where where
exprToType = do exprToType = do
modSum <- getModSummary $ mkModuleName modstr modSum <- G.getModSummary $ G.mkModuleName modstr
p <- parseModule modSum p <- G.parseModule modSum
tcm@TypecheckedModule{tm_typechecked_source = tcs} <- typecheckModule p tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p
let bs = listifySpans tcs (lineNo, colNo) :: [LHsBind Id] let bs = listifySpans tcs (lineNo, colNo) :: [LHsBind Id]
es = listifySpans tcs (lineNo, colNo) :: [LHsExpr Id] es = listifySpans tcs (lineNo, colNo) :: [LHsExpr Id]
ps = listifySpans tcs (lineNo, colNo) :: [LPat Id] ps = listifySpans tcs (lineNo, colNo) :: [LPat Id]
bts <- mapM (getType tcm) bs bts <- mapM (getType tcm) bs
ets <- mapM (getType tcm) es ets <- mapM (getType tcm) es
pts <- mapM (getType tcm) ps pts <- mapM (getType tcm) ps
dflag <- getSessionDynFlags dflag <- G.getSessionDynFlags
let sss = map (toTup dflag) $ sortBy (cmp `on` fst) $ catMaybes $ concat [ets, bts, pts] let sss = map (toTup dflag) $ sortBy (cmp `on` fst) $ catMaybes $ concat [ets, bts, pts]
return $ convert opt sss return $ convert opt sss
@ -116,8 +117,8 @@ typeOf opt cradle file modstr lineNo colNo =
fourInts = fromMaybe (0,0,0,0) . Gap.getSrcSpan fourInts = fromMaybe (0,0,0,0) . Gap.getSrcSpan
cmp a b cmp a b
| a `isSubspanOf` b = O.LT | a `G.isSubspanOf` b = O.LT
| b `isSubspanOf` a = O.GT | b `G.isSubspanOf` a = O.GT
| otherwise = O.EQ | otherwise = O.EQ
errmsg = convert opt ([] :: [((Int,Int,Int,Int),String)]) errmsg = convert opt ([] :: [((Int,Int,Int,Int),String)])
@ -125,7 +126,7 @@ typeOf opt cradle file modstr lineNo colNo =
listifySpans :: Typeable a => TypecheckedSource -> (Int, Int) -> [Located a] listifySpans :: Typeable a => TypecheckedSource -> (Int, Int) -> [Located a]
listifySpans tcs lc = listifyStaged TypeChecker p tcs listifySpans tcs lc = listifyStaged TypeChecker p tcs
where where
p (L spn _) = isGoodSrcSpan spn && spn `spans` lc p (L spn _) = G.isGoodSrcSpan spn && spn `G.spans` lc
listifyStaged :: Typeable r => Stage -> (r -> Bool) -> GenericQ [r] listifyStaged :: Typeable r => Stage -> (r -> Bool) -> GenericQ [r]
listifyStaged s p = everythingStaged s (++) [] ([] `mkQ` (\x -> [x | p x])) listifyStaged s p = everythingStaged s (++) [] ([] `mkQ` (\x -> [x | p x]))
@ -142,27 +143,27 @@ inModuleContext _ opt cradle file modstr action errmsg =
valid = do valid = do
void $ initializeFlagsWithCradle opt cradle ["-w:"] False void $ initializeFlagsWithCradle opt cradle ["-w:"] False
setTargetFiles [file] setTargetFiles [file]
void $ load LoadAllTargets void $ G.load LoadAllTargets
doif setContextFromTarget action doif setContextFromTarget action
invalid = do invalid = do
void $ initializeFlagsWithCradle opt cradle ["-w:"] False void $ initializeFlagsWithCradle opt cradle ["-w:"] False
setTargetBuffer setTargetBuffer
void $ load LoadAllTargets void $ G.load LoadAllTargets
doif setContextFromTarget action doif setContextFromTarget action
setTargetBuffer = do setTargetBuffer = do
modgraph <- depanal [mkModuleName modstr] True modgraph <- G.depanal [G.mkModuleName modstr] True
dflag <- getSessionDynFlags dflag <- G.getSessionDynFlags
let imports = concatMap (map (showQualifiedPage dflag . ppr . unLoc)) $ let imports = concatMap (map (showQualifiedPage dflag . ppr . G.unLoc)) $
map ms_imps modgraph ++ map ms_srcimps modgraph map ms_imps modgraph ++ map G.ms_srcimps modgraph
moddef = "module " ++ sanitize modstr ++ " where" moddef = "module " ++ sanitize modstr ++ " where"
header = moddef : imports header = moddef : imports
importsBuf <- Gap.toStringBuffer header importsBuf <- Gap.toStringBuffer header
clkTime <- liftIO getCurrentTime clkTime <- liftIO getCurrentTime
setTargets [Gap.mkTarget (TargetModule $ mkModuleName modstr) G.setTargets [Gap.mkTarget (TargetModule $ G.mkModuleName modstr)
True True
(Just (importsBuf, clkTime))] (Just (importsBuf, clkTime))]
doif m t = m >>= \ok -> if ok then t else goNext doif m t = m >>= \ok -> if ok then t else goNext
sanitize = fromMaybe "SomeModule" . listToMaybe . words sanitize = fromMaybe "SomeModule" . listToMaybe . words
setContextFromTarget :: Ghc Bool setContextFromTarget :: Ghc Bool
setContextFromTarget = depanal [] False >>= Gap.setCtx setContextFromTarget = G.depanal [] False >>= Gap.setCtx

View File

@ -1,11 +1,11 @@
module Language.Haskell.GhcMod.Lint where module Language.Haskell.GhcMod.Lint where
import Control.Applicative import Control.Applicative ((<$>))
import Control.Exception (finally) import Control.Exception (finally)
import Data.List import Data.List (intercalate)
import GHC.IO.Handle (hDuplicate, hDuplicateTo) import GHC.IO.Handle (hDuplicate, hDuplicateTo)
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
import Language.Haskell.HLint import Language.Haskell.HLint (hlint)
import System.Directory (getTemporaryDirectory, removeFile) import System.Directory (getTemporaryDirectory, removeFile)
import System.IO (hClose, openTempFile, stdout) import System.IO (hClose, openTempFile, stdout)