using check finally.
This commit is contained in:
parent
bb38a930e7
commit
411a584bb8
@ -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.
|
||||||
|
@ -23,7 +23,6 @@ module Language.Haskell.GhcMod.Internal (
|
|||||||
, initializeFlagsWithCradle
|
, initializeFlagsWithCradle
|
||||||
-- * Targets
|
-- * Targets
|
||||||
, setTargetFiles
|
, setTargetFiles
|
||||||
, addTargetFiles
|
|
||||||
-- * Logging
|
-- * Logging
|
||||||
, withLogger
|
, withLogger
|
||||||
, setNoWaringFlags
|
, setNoWaringFlags
|
||||||
|
@ -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
|
||||||
|
isSameMainFile file (Just x)
|
||||||
|
| mainfile == file = Nothing
|
||||||
|
| otherwise = Just mainfile
|
||||||
|
where
|
||||||
|
mmainfile = G.ml_hs_file (G.ms_location x)
|
||||||
-- G.ms_hspp_file x is a temporary file with CPP.
|
-- G.ms_hspp_file x is a temporary file with CPP.
|
||||||
-- this is a just fake.
|
-- this is a just fake.
|
||||||
mainfile = fromMaybe (G.ms_hspp_file x) mmainfile
|
mainfile = fromMaybe (G.ms_hspp_file x) mmainfile
|
||||||
if mainfile == file then
|
|
||||||
return Nothing
|
----------------------------------------------------------------
|
||||||
else do
|
|
||||||
let target = TargetFile mainfile Nothing
|
|
||||||
G.removeTarget target
|
|
||||||
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')
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user