Load all mapped targets

This commit is contained in:
Nikolay Yakimov 2015-06-16 11:28:46 +03:00
parent e70988e15f
commit f8a0325617
2 changed files with 12 additions and 3 deletions

View File

@ -53,6 +53,7 @@ module Language.Haskell.GhcMod.Monad.Types (
, addMMappedFile , addMMappedFile
, delMMappedFile , delMMappedFile
, lookupMMappedFile , lookupMMappedFile
, getMMappedFilePaths
-- * Re-exporting convenient stuff -- * Re-exporting convenient stuff
, MonadIO , MonadIO
, liftIO , liftIO
@ -464,6 +465,9 @@ lookupMMappedFile :: GmState m => FilePath -> m (Maybe FileMapping)
lookupMMappedFile t = lookupMMappedFile t =
M.lookup t `liftM` getMMappedFiles M.lookup t `liftM` getMMappedFiles
getMMappedFilePaths :: GmState m => m [FilePath]
getMMappedFilePaths = M.keys `liftM` getMMappedFiles
withOptions :: GmEnv m => (Options -> Options) -> m a -> m a withOptions :: GmEnv m => (Options -> Options) -> m a -> m a
withOptions changeOpt action = gmeLocal changeEnv action withOptions changeOpt action = gmeLocal changeEnv action
where where

View File

@ -53,6 +53,8 @@ import Data.Map (Map)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Set (Set) import Data.Set (Set)
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.List (nubBy)
import Data.Function (on)
import Distribution.Helper import Distribution.Helper
import Prelude hiding ((.)) import Prelude hiding ((.))
@ -163,12 +165,15 @@ runGmlTWith efnmns' mdf wrapper action = do
initSession opts' $ initSession opts' $
setModeSimple >>> setEmptyLogger >>> mdf setModeSimple >>> setEmptyLogger >>> mdf
mappedStrs <- getMMappedFilePaths
let targetStrs = mappedStrs ++ map moduleNameString mns ++ cfns
unGmlT $ wrapper $ do unGmlT $ wrapper $ do
targets <- targets <-
withLightHscEnv opts $ \env -> withLightHscEnv opts $ \env ->
mapM (`guessTarget` Nothing) (map moduleNameString mns ++ cfns) liftM (nubBy ((==) `on` targetId))
>>= mapM (mapFile env) (mapM ((`guessTarget` Nothing) >=> mapFile env) targetStrs)
>>= mapM relativize >>= mapM relativize
loadTargets targets loadTargets targets
action action
where where