diff --git a/Language/Haskell/GhcImportedFrom.hs b/Language/Haskell/GhcImportedFrom.hs --- a/Language/Haskell/GhcImportedFrom.hs +++ b/Language/Haskell/GhcImportedFrom.hs @@ -78,6 +78,7 @@ import System.IO import System.Process import TcRnTypes() +import HsImpExp import qualified DynFlags() import qualified GhcMonad @@ -92,6 +93,9 @@ , Cradle(..) ) +import Language.Haskell.GhcMod.Monad ( runGmOutT ) +import qualified Language.Haskell.GhcMod.Types as GhcModTypes + import Language.Haskell.GhcImportedFrom.UtilsFromGhcMod import Language.Haskell.GhcImportedFrom.Types @@ -100,6 +104,8 @@ import qualified Text.Parsec as TP import Data.Functor.Identity +import Debug.Trace + #if __GLASGOW_HASKELL__ >= 708 import DynFlags ( unsafeGlobalDynFlags ) tdflags = unsafeGlobalDynFlags @@ -335,7 +341,14 @@ grabNames loc = showSDoc tdflags (ppr names) where names = GHC.ieNames $ SrcLoc.unLoc loc - parseHiding :: Maybe (Bool, [Located (IE RdrName)]) -> [Maybe String] + grabNames' :: GHC.Located [GHC.LIE GHC.RdrName] -> [String] + grabNames' loc = map (\n -> showSDoc tdflags (ppr n)) names + where names :: [RdrName] + names = map (ieName . SrcLoc.unLoc) $ SrcLoc.unLoc loc + -- FIXME We are throwing away location info by using unLoc each time? + -- Trace these things to see what we are losing. + -- + parseHiding :: Maybe (Bool, Located [LIE RdrName]) -> [Maybe String] parseHiding Nothing = [Nothing] -- If we do @@ -348,10 +361,10 @@ -- Actually hid names, e.g. -- -- import Data.List hiding (map) - parseHiding (Just (True, h)) = map (Just . grabNames) h + parseHiding (Just (True, h)) = map Just $ grabNames' h - parseSpecifically :: Maybe (Bool, [Located (IE RdrName)]) -> [String] - parseSpecifically (Just (False, h)) = map grabNames h + parseSpecifically :: Maybe (Bool, Located [LIE RdrName]) -> [String] + parseSpecifically (Just (False, h)) = grabNames' h parseSpecifically _ = [] -- |Find all matches for a symbol in a source file. The last parameter is a list of @@ -632,18 +645,19 @@ -- | When we use 'parseName' to convert a 'String' to a 'Name' we get a list of matches instead of -- a unique match, so we end up having to guess the best match based on the qualified name. bestPrefixMatches :: Name -> [GlobalRdrElt] -> [String] -bestPrefixMatches name lookUp = x'' +bestPrefixMatches name lookUp + = case moduleOfQualifiedName name' of + Just name'' -> filter (name'' `isPrefixOf`) x' + Nothing -> [] where name' = showSDoc tdflags $ ppr name - name'' = fromJust $ moduleOfQualifiedName name' -- FIXME dangerous fromJust x = concatMap symbolImportedFrom lookUp x' = map (showSDoc tdflags . ppr) x - x'' = filter (name'' `isPrefixOf`) x' -- | Find the haddock module. Returns a 4-tuple consisting of: module that the symbol is imported -- from, haddock url, module, and module's HTML filename. findHaddockModule :: QualifiedName -> [HaskellModule] -> [String] -> GhcPkgOptions -> (Name, [GlobalRdrElt]) -> IO [(Maybe String, Maybe String, Maybe String, Maybe String)] findHaddockModule symbol'' smatches allGhcOpts ghcpkgOpts (name, lookUp) = do - -- FIXME this is messy - the code below has a dodgy fromJust... + -- FIXME this is messy if isJust (moduleOfQualifiedName symbol'') then do let lastBitOfSymbol = last $ separateBy '.' symbol'' @@ -657,7 +671,9 @@ importedFrom = if null smatches then if null bpms then map (showSDoc tdflags . ppr) $ concatMap symbolImportedFrom lookUp else catMaybes $ return $ Safe.headMay bpms - else return $ ((showSDoc tdflags . ppr) . mkModuleName . fromJust . moduleOfQualifiedName) symbol'' -- FIXME dangerous fromJust + else return $ case moduleOfQualifiedName symbol'' of + Nothing -> trace "Got Nothing when looking up module of qualified name." [] + Just modOfQualSym'' -> ((showSDoc tdflags . ppr) . mkModuleName) modOfQualSym'' putStrLn $ "definedIn: " ++ showSDoc tdflags (ppr definedIn) putStrLn $ "bpms: " ++ show bpms @@ -778,7 +794,7 @@ guessHaddockUrl :: FilePath -> String -> Symbol -> Int -> Int -> GhcOptions -> GhcPkgOptions -> IO (Either String [String]) guessHaddockUrl _targetFile targetModule symbol lineNr colNr (GhcOptions ghcOpts0) ghcpkgOptions = do - cradle <- findCradle + cradle <- runGmOutT GhcModTypes.defaultOptions $ findCradle let currentDir = cradleCurrentDir cradle workDir = cradleRootDir cradle setCurrentDirectory workDir diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,8 @@ +2016-01-20 v0.2.1.0 + +* Builds on GHC 7.10.3 with the latest version of ghc-mod + that is available on Hackage. + 2015-08-17 v0.2.0.7 * Added a fall-back case when our resolved qualified name diff --git a/ghc-imported-from.cabal b/ghc-imported-from.cabal --- a/ghc-imported-from.cabal +++ b/ghc-imported-from.cabal @@ -1,5 +1,5 @@ name: ghc-imported-from -version: 0.2.0.7 +version: 0.2.1.0 synopsis: Find the Haddock documentation for a symbol. description: Given a Haskell module and symbol, determine the URL to the Haddock documentation for that symbol. @@ -25,12 +25,12 @@ Language.Haskell.GhcImportedFrom.Types other-extensions: CPP, Rank2Types - build-depends: base < 4.8 + build-depends: base >=4.0 && <5 , syb , ghc , ghc-paths , ghc-syb-utils - , ghc-mod >= 4.1.1 + , ghc-mod >= 5.4.0.0 , filepath , safe , process @@ -51,7 +51,7 @@ main-is: fake-ghc-for-ghc-imported-from.hs GHC-Options: -Wall hs-source-dirs: src - build-depends: base < 4.8 + build-depends: base >=4.0 && <5 , process default-language: Haskell2010 @@ -60,12 +60,12 @@ GHC-Options: -Wall other-modules: Paths_ghc_imported_from other-extensions: CPP, Rank2Types - build-depends: base < 4.8 + build-depends: base >=4.0 && <5 , syb , ghc , ghc-paths , ghc-syb-utils - , ghc-mod >= 4.1.1 + , ghc-mod >= 5.4.0.0 , ghc-imported-from , filepath , safe @@ -94,12 +94,12 @@ Type: exitcode-stdio-1.0 Other-Modules: Dir ImportedFromSpec - Build-Depends: base < 4.8 + Build-Depends: base >=4.0 && <5 , syb , ghc , ghc-paths , ghc-syb-utils - , ghc-mod >= 4.1.1 + , ghc-mod >= 5.4.0.0 , filepath , safe , process