fixing double Main problem.
This commit is contained in:
parent
b2c4212c01
commit
d6d50cff1e
@ -2,11 +2,12 @@
|
|||||||
|
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
|
import Control.Applicative ((<$>))
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import qualified Control.Exception as E (handle, SomeException(..))
|
import qualified Control.Exception as E (handle, SomeException(..))
|
||||||
import Control.Monad (when, void)
|
import Control.Monad (when, void)
|
||||||
import Data.Function
|
import Data.Function
|
||||||
import Data.List (intercalate, groupBy, sort)
|
import Data.List (intercalate, groupBy, sort, find)
|
||||||
import Data.Map.Strict (Map)
|
import Data.Map.Strict (Map)
|
||||||
import qualified Data.Map.Strict as M
|
import qualified Data.Map.Strict as M
|
||||||
import Data.Set (Set)
|
import Data.Set (Set)
|
||||||
@ -91,16 +92,33 @@ checkStx :: Set FilePath
|
|||||||
checkStx set ls readLog file = do
|
checkStx set ls readLog file = do
|
||||||
let add = not $ S.member file set
|
let add = not $ S.member file set
|
||||||
G.ghandle handler $ do
|
G.ghandle handler $ do
|
||||||
|
mdel <- removeMainTarget
|
||||||
when add $ addTargetFiles [file]
|
when add $ addTargetFiles [file]
|
||||||
void $ load LoadAllTargets
|
void $ load LoadAllTargets
|
||||||
msgs <- liftIO $ readLog
|
msgs <- liftIO $ readLog
|
||||||
let set' = if add then S.insert file set else set
|
let set1 = if add then S.insert file set else set
|
||||||
return (msgs, True, set')
|
set2 = case mdel of
|
||||||
|
Nothing -> set1
|
||||||
|
Just delfl -> S.delete delfl set1
|
||||||
|
return (msgs, True, set2)
|
||||||
where
|
where
|
||||||
handler :: SourceError -> Ghc ([String], Bool, Set FilePath)
|
handler :: SourceError -> Ghc ([String], Bool, Set FilePath)
|
||||||
handler err = do
|
handler err = do
|
||||||
errmsgs <- handleErrMsg ls err
|
errmsgs <- handleErrMsg ls err
|
||||||
return (errmsgs, False, set)
|
return (errmsgs, False, set)
|
||||||
|
removeMainTarget = do
|
||||||
|
mx <- find isMain <$> getModuleGraph
|
||||||
|
case mx of
|
||||||
|
Nothing -> return Nothing
|
||||||
|
Just x -> do
|
||||||
|
let mainfile = ms_hspp_file x
|
||||||
|
if mainfile == file then
|
||||||
|
return Nothing
|
||||||
|
else do
|
||||||
|
let target = TargetFile mainfile Nothing
|
||||||
|
removeTarget target
|
||||||
|
return $ Just mainfile
|
||||||
|
isMain m = moduleNameString (moduleName (ms_mod m)) == "Main"
|
||||||
|
|
||||||
findSym :: Set FilePath -> MVar DB -> String
|
findSym :: Set FilePath -> MVar DB -> String
|
||||||
-> Ghc ([String], Bool, Set FilePath)
|
-> Ghc ([String], Bool, Set FilePath)
|
||||||
|
Loading…
Reference in New Issue
Block a user