using check finally.

This commit is contained in:
Kazu Yamamoto 2014-04-28 16:31:28 +09:00
parent bb38a930e7
commit 411a584bb8
3 changed files with 31 additions and 37 deletions

View File

@ -5,7 +5,6 @@ module Language.Haskell.GhcMod.GHCApi (
, withGHC' , withGHC'
, initializeFlagsWithCradle , initializeFlagsWithCradle
, setTargetFiles , setTargetFiles
, addTargetFiles
, getDynamicFlags , getDynamicFlags
, getSystemLibDir , getSystemLibDir
, withDynFlags , withDynFlags
@ -160,13 +159,6 @@ setTargetFiles files = do
G.setTargets targets G.setTargets targets
void $ G.load LoadAllTargets void $ G.load LoadAllTargets
-- | Adding the files to the targets.
addTargetFiles :: (GhcMonad m) => [FilePath] -> m ()
addTargetFiles files = do
targets <- forM files $ \file -> G.guessTarget file Nothing
mapM_ G.addTarget targets
void $ G.load LoadAllTargets
---------------------------------------------------------------- ----------------------------------------------------------------
-- | Return the 'DynFlags' currently in use in the GHC session. -- | Return the 'DynFlags' currently in use in the GHC session.

View File

@ -23,7 +23,6 @@ module Language.Haskell.GhcMod.Internal (
, initializeFlagsWithCradle , initializeFlagsWithCradle
-- * Targets -- * Targets
, setTargetFiles , setTargetFiles
, addTargetFiles
-- * Logging -- * Logging
, withLogger , withLogger
, setNoWaringFlags , setNoWaringFlags

View File

@ -31,7 +31,7 @@ import Data.Set (Set)
import qualified Data.Set as S import qualified Data.Set as S
import Data.Typeable (Typeable) import Data.Typeable (Typeable)
import Data.Version (showVersion) import Data.Version (showVersion)
import GHC (Ghc, TargetId(TargetFile)) import GHC (Ghc)
import qualified GHC as G import qualified GHC as G
import Language.Haskell.GhcMod import Language.Haskell.GhcMod
import Language.Haskell.GhcMod.Ghc import Language.Haskell.GhcMod.Ghc
@ -166,37 +166,40 @@ checkStx :: Options
-> FilePath -> FilePath
-> Ghc (String, Bool, Set FilePath) -> Ghc (String, Bool, Set FilePath)
checkStx opt set file = do checkStx opt set file = do
(set',add) <- removeMainTarget file set set' <- newFileSet set file
let files = if add then [file] else [] let files = S.toList set'
eret <- withLogger opt setAllWaringFlags $ addTargetFiles files eret <- check opt files
case eret of case eret of
Right ret -> return (ret, True, set') Right ret -> return (ret, True, set')
Left ret -> return (ret, True, set) -- fxime: set Left ret -> return (ret, True, set) -- fxime: set
removeMainTarget :: FilePath -> Set FilePath -> Ghc (Set FilePath, Bool) newFileSet :: Set FilePath -> FilePath -> Ghc (Set FilePath)
removeMainTarget file set = do newFileSet set file = do
mx <- find isMain <$> G.getModuleGraph let set1
mdel <- tryRemove mx | S.member file set = set
let set' = del mdel | otherwise = S.insert file set
return (set',add) mx <- isSameMainFile file <$> getModSummaryForMain
return $ case mx of
Nothing -> set1
Just mainfile -> S.delete mainfile set1
getModSummaryForMain :: Ghc (Maybe G.ModSummary)
getModSummaryForMain = find isMain <$> G.getModuleGraph
where where
add = not $ S.member file set
set1 = if add then S.insert file set else set
del Nothing = set1
del (Just delfl) = S.delete delfl set1
isMain m = G.moduleNameString (G.moduleName (G.ms_mod m)) == "Main" isMain m = G.moduleNameString (G.moduleName (G.ms_mod m)) == "Main"
tryRemove Nothing = return Nothing
tryRemove (Just x) = do isSameMainFile :: FilePath -> (Maybe G.ModSummary) -> Maybe FilePath
let mmainfile = G.ml_hs_file (G.ms_location x) isSameMainFile _ Nothing = Nothing
-- G.ms_hspp_file x is a temporary file with CPP. isSameMainFile file (Just x)
-- this is a just fake. | mainfile == file = Nothing
mainfile = fromMaybe (G.ms_hspp_file x) mmainfile | otherwise = Just mainfile
if mainfile == file then where
return Nothing mmainfile = G.ml_hs_file (G.ms_location x)
else do -- G.ms_hspp_file x is a temporary file with CPP.
let target = TargetFile mainfile Nothing -- this is a just fake.
G.removeTarget target mainfile = fromMaybe (G.ms_hspp_file x) mmainfile
return $ Just mainfile
----------------------------------------------------------------
findSym :: Options -> Set FilePath -> String -> MVar SymMdlDb findSym :: Options -> Set FilePath -> String -> MVar SymMdlDb
-> Ghc (String, Bool, Set FilePath) -> Ghc (String, Bool, Set FilePath)
@ -238,7 +241,7 @@ showInfo :: Options
-> Ghc (String, Bool, Set FilePath) -> Ghc (String, Bool, Set FilePath)
showInfo opt set fileArg = do showInfo opt set fileArg = do
let [file, expr] = words fileArg let [file, expr] = words fileArg
(set',_) <- removeMainTarget file set set' <- newFileSet set file
ret <- info opt file expr ret <- info opt file expr
return (ret, True, set') return (ret, True, set')
@ -248,7 +251,7 @@ showType :: Options
-> Ghc (String, Bool, Set FilePath) -> Ghc (String, Bool, Set FilePath)
showType opt set fileArg = do showType opt set fileArg = do
let [file, line, column] = words fileArg let [file, line, column] = words fileArg
(set',_) <- removeMainTarget file set set' <- newFileSet set file
ret <- types opt file (read line) (read column) ret <- types opt file (read line) (read column)
return (ret, True, set') return (ret, True, set')