hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Revert "use standard findFile instead of hand-rolled one"

Browse Source 
This reverts commit b055098127.
This commit is contained in:
Daniel Gröber 2015-05-20 12:05:22 +02:00
parent 079c05ff17
commit a2e4a5d683
1 changed files with 7 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Language/Haskell/GhcMod/Target.hs
View File

@ -37,8 +37,10 @@ import Language.Haskell.GhcMod.GhcPkg
import Language.Haskell.GhcMod.Error import Language.Haskell.GhcMod.Error
import Language.Haskell.GhcMod.Logging import Language.Haskell.GhcMod.Logging
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Utils
import Data.Maybe import Data.Maybe
import Data.Monoid
import Data.Either import Data.Either
import Data.Foldable (foldrM) import Data.Foldable (foldrM)
import Data.Traversable (traverse) import Data.Traversable (traverse)
@ -313,7 +315,7 @@ resolveModule :: MonadIO m =>
resolveModule env _srcDirs (Right mn) = resolveModule env _srcDirs (Right mn) =
liftIO $ traverse canonicalizeModulePath =<< findModulePath env mn liftIO $ traverse canonicalizeModulePath =<< findModulePath env mn
resolveModule env srcDirs (Left fn') = liftIO $ do resolveModule env srcDirs (Left fn') = liftIO $ do
mfn <- findFile srcDirs fn' mfn <- findFile' srcDirs fn'
case mfn of case mfn of
Nothing -> return Nothing Nothing -> return Nothing
Just fn'' -> do Just fn'' -> do
@ -325,6 +327,9 @@ resolveModule env srcDirs (Left fn') = liftIO $ do
case mmn of case mmn of
Nothing -> mkMainModulePath fn Nothing -> mkMainModulePath fn
Just mn -> ModulePath mn fn Just mn -> ModulePath mn fn
where
findFile' dirs file =
getFirst . mconcat <$> mapM (fmap First . mightExist . (</>file)) dirs
resolveChEntrypoints :: resolveChEntrypoints ::
FilePath -> ChEntrypoint -> IO [Either FilePath ModuleName] FilePath -> ChEntrypoint -> IO [Either FilePath ModuleName]
@ -360,6 +365,7 @@ resolveGmComponents mumns cs = do
else insertUpdated m c else insertUpdated m c
gmsPut s { gmComponents = m' } gmsPut s { gmComponents = m' }
return m' return m'
where where
foldrM' b fa f = foldrM f b fa foldrM' b fa f = foldrM f b fa
insertUpdated m c = do insertUpdated m c = do