ghc-imported-from 0.2.0.2 → 0.2.0.3
raw patch · 5 files changed
+260/−103 lines, 5 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Language.Haskell.GhcImportedFrom: findHaddockModule :: QualifiedName -> [HaskellModule] -> GhcPkgOptions -> (Name, [GlobalRdrElt]) -> IO (Maybe String, Maybe String, Maybe String, Maybe String)
+ Language.Haskell.GhcImportedFrom: findHaddockModule :: QualifiedName -> [HaskellModule] -> GhcPkgOptions -> (Name, [GlobalRdrElt]) -> IO [(Maybe String, Maybe String, Maybe String, Maybe String)]
- Language.Haskell.GhcImportedFrom: getSummary :: GhcOptions -> FilePath -> String -> IO ([String], [GHCOption], ModSummary)
+ Language.Haskell.GhcImportedFrom: getSummary :: GhcMonad m => GhcOptions -> FilePath -> String -> m ([String], [GHCOption], ModSummary)
- Language.Haskell.GhcImportedFrom: getTextualImports :: GhcOptions -> FilePath -> String -> IO [Located (ImportDecl RdrName)]
+ Language.Haskell.GhcImportedFrom: getTextualImports :: GhcMonad m => GhcOptions -> FilePath -> String -> m [Located (ImportDecl RdrName)]
- Language.Haskell.GhcImportedFrom: guessHaddockUrl :: FilePath -> String -> Symbol -> Int -> Int -> GhcOptions -> GhcPkgOptions -> IO (Either String String)
+ Language.Haskell.GhcImportedFrom: guessHaddockUrl :: FilePath -> String -> Symbol -> Int -> Int -> GhcOptions -> GhcPkgOptions -> IO (Either String [String])
- Language.Haskell.GhcImportedFrom: lookupSymbol :: GhcOptions -> FilePath -> String -> String -> [String] -> IO [(Name, [GlobalRdrElt])]
+ Language.Haskell.GhcImportedFrom: lookupSymbol :: GhcOptions -> String -> String -> String -> [String] -> Ghc [(Name, [GlobalRdrElt])]
- Language.Haskell.GhcImportedFrom: qualifiedName :: GhcOptions -> FilePath -> String -> Int -> Int -> [String] -> IO [String]
+ Language.Haskell.GhcImportedFrom: qualifiedName :: GhcOptions -> FilePath -> String -> Int -> Int -> [String] -> Ghc [String]
Files
- Language/Haskell/GhcImportedFrom.hs +215/−96
- README.md +29/−1
- changelog.md +5/−0
- ghc-imported-from.cabal +5/−4
- test/ImportedFromSpec.hs +6/−2
Language/Haskell/GhcImportedFrom.hs view
@@ -117,7 +117,7 @@ then return "" else do firstLine <- hGetLine hout if "GHCi" `isPrefixOf` firstLine- then return "DERP" -- stuffed up, should report error+ then return "DERP" -- stuffed up, should report error - FIXME change this to an error or something? else do rest <- readRestOfHandle hout return $ firstLine ++ "\n" ++ rest @@ -202,22 +202,20 @@ -- -- See also 'toHaskellModule' and 'getSummary'. -getTextualImports :: GhcOptions -> FilePath -> String -> IO [SrcLoc.Located (ImportDecl RdrName)]+getTextualImports :: GhcMonad m => GhcOptions -> FilePath -> String -> m [SrcLoc.Located (ImportDecl RdrName)] getTextualImports ghcopts targetFile targetModuleName = do- putStrLn $ "getTextualImports: " ++ show (targetFile, targetModuleName)+ GhcMonad.liftIO $ putStrLn $ "getTextualImports: " ++ show (targetFile, targetModuleName) (ghcOpts1, ghcOpts2, modSum) <- getSummary ghcopts targetFile targetModuleName - putStrLn $ "getTextualImports: ghcOpts1: " ++ show ghcOpts1- putStrLn $ "getTextualImports: ghcOpts2: " ++ show ghcOpts2+ GhcMonad.liftIO $ putStrLn $ "getTextualImports: ghcOpts1: " ++ show ghcOpts1+ GhcMonad.liftIO $ putStrLn $ "getTextualImports: ghcOpts2: " ++ show ghcOpts2 return $ ms_textual_imps modSum -- | Get the module summary for a particular file/module. The first and second components of the -- return value are @ghcOpts1@ and @ghcOpts2@; see 'setDynamicFlags'.-getSummary :: GhcOptions -> FilePath -> String -> IO ([String], [GHCOption], ModSummary)-getSummary ghcopts targetFile targetModuleName =- -- defaultErrorHandler defaultFatalMessager defaultFlushOut $- runGhc (Just libdir) $ do+getSummary :: GhcMonad m => GhcOptions -> FilePath -> String -> m ([String], [GHCOption], ModSummary)+getSummary ghcopts targetFile targetModuleName = do GhcMonad.liftIO $ putStrLn $ "getSummary, setting dynamic flags..." (ghcOpts1, ghcOpts2, _) <- getSessionDynFlags >>= setDynamicFlags ghcopts @@ -231,14 +229,19 @@ GhcMonad.liftIO $ putStrLn $ "getSummary, setting the context..." (setContext [(IIDecl . simpleImportDecl . mkModuleName) targetModuleName])- `gcatch` (\(_ :: SourceError) -> GhcMonad.liftIO (putStrLn "getSummary: setContext failed with a SourceError, trying to continue anyway..."))- `gcatch` (\(_ :: GhcApiError) -> GhcMonad.liftIO (putStrLn "getSummary: setContext failed with a GhcApiError, trying to continue anyway..."))- `gcatch` (\(_ :: SomeException) -> GhcMonad.liftIO (putStrLn "getSummary: setContext failed with a SomeException, trying to continue anyway..."))+ `gcatch` (\(e :: SourceError) -> GhcMonad.liftIO (putStrLn $ "getSummary: setContext failed with a SourceError, trying to continue anyway..." ++ show e))+ `gcatch` (\(g :: GhcApiError) -> GhcMonad.liftIO (putStrLn $ "getSummary: setContext failed with a GhcApiError, trying to continue anyway..." ++ show g))+ `gcatch` (\(se :: SomeException) -> GhcMonad.liftIO (putStrLn $ "getSummary: setContext failed with a SomeException, trying to continue anyway..." ++ show se)) -- Extract the module summary. GhcMonad.liftIO $ putStrLn $ "getSummary, extracting the module summary..." modSum <- getModSummary (mkModuleName targetModuleName) + -- graph <- GHC.depanal [] False+ -- -- graph <- getModuleGraph+ -- let graph_names = map (GHC.moduleNameString . GHC.ms_mod_name) graph+ -- GhcMonad.liftIO $ print $ "graph_names: " ++ show graph_names+ return (ghcOpts1, ghcOpts2, modSum) -- |Convenience function for converting an 'GHC.ImportDecl' to a 'HaskellModule'.@@ -333,42 +336,52 @@ -- imported from `Data.List' at tests/data/data/Hiding.hs:5:1-29 -- (and originally defined in `base:GHC.List')])] -lookupSymbol :: GhcOptions -> FilePath -> String -> String -> [String] -> IO [(Name, [GlobalRdrElt])]-lookupSymbol ghcopts targetFile targetModuleName qualifiedSymbol importList =- -- defaultErrorHandler defaultFatalMessager defaultFlushOut $- runGhc (Just libdir) $ do- _ <- getSessionDynFlags >>= setDynamicFlags ghcopts-- target <- guessTarget targetFile Nothing- setTargets [target]- _ <- load LoadAllTargets+lookupSymbol :: GhcOptions -> String -> String -> String -> [String] -> Ghc [(Name, [GlobalRdrElt])]+lookupSymbol ghcopts targetFile targetModuleName qualifiedSymbol importList = do+ GhcMonad.liftIO $ putStrLn $ "lookupSymbol::: " ++ show (ghcopts, targetFile, targetModuleName, qualifiedSymbol, importList) -- Bring in the target module and its imports. (setContext $ map (IIDecl . simpleImportDecl . mkModuleName) (targetModuleName:importList))- `gcatch` (\(_ :: SourceError) -> do GhcMonad.liftIO $ putStrLn "lookupSymbol: setContext failed with a SourceError, trying to continue anyway..."+ `gcatch` (\(s :: SourceError) -> do GhcMonad.liftIO $ putStrLn $ "lookupSymbol: setContext failed with a SourceError, trying to continue anyway..." ++ show s setContext $ map (IIDecl . simpleImportDecl . mkModuleName) importList)- `gcatch` (\(_ :: GhcApiError) -> do GhcMonad.liftIO $ putStrLn "lookupSymbol: setContext failed with a GhcApiError, trying to continue anyway..."+ `gcatch` (\(g :: GhcApiError) -> do GhcMonad.liftIO $ putStrLn $ "lookupSymbol: setContext failed with a GhcApiError, trying to continue anyway..." ++ show g setContext $ map (IIDecl . simpleImportDecl . mkModuleName) importList)- `gcatch` (\(_ :: SomeException) -> do GhcMonad.liftIO $ putStrLn "lookupSymbol: setContext failed with a SomeException, trying to continue anyway..."+ `gcatch` (\(se :: SomeException) -> do GhcMonad.liftIO $ putStrLn $ "lookupSymbol: setContext failed with a SomeException, trying to continue anyway..." ++ show se setContext $ map (IIDecl . simpleImportDecl . mkModuleName) importList) + GhcMonad.liftIO $ putStrLn $ "lookupSymbol::: continuing1..."+ -- Get the module summary, then parse it, type check it, and desugar it. modSummary <- getModSummary $ mkModuleName targetModuleName :: Ghc ModSummary p <- parseModule modSummary :: Ghc ParsedModule t <- typecheckModule p :: Ghc TypecheckedModule d <- desugarModule t :: Ghc DesugaredModule + GhcMonad.liftIO $ putStrLn $ "lookupSymbol::: continuing2..."+ -- The "guts" has the global reader environment, which we need. let guts = coreModule d :: ModGuts gre = HscTypes.mg_rdr_env guts :: GlobalRdrEnv - -- Beware that parseName expects an unambiguous symbol otherwise it causes a- -- GHC panic. A fully qualified name should suffice. Is there a way to- -- catch this exception?- names <- parseName qualifiedSymbol+ GhcMonad.liftIO $ putStrLn $ "lookupSymbol::: continuing3..."++ -- parseName expects an unambiguous symbol otherwise it causes a+ -- GHC panic. A fully qualified name should suffice. If this step+ -- fails we return an empty list.+ names <- (parseName qualifiedSymbol)+ `gcatch` (\(s :: SourceError) -> do GhcMonad.liftIO $ putStrLn $ "lookupSymbol: parseName failed with a SourceError, trying to continue anyway..." ++ show s+ return [])+ `gcatch` (\(g :: GhcApiError) -> do GhcMonad.liftIO $ putStrLn $ "lookupSymbol: parseName failed with a GhcApiError, trying to continue anyway..." ++ show g+ return [])+ `gcatch` (\(se :: SomeException) -> do GhcMonad.liftIO $ putStrLn $ "lookupSymbol: parseName failed with a SomeException, trying to continue anyway..." ++ show se+ return [])++ GhcMonad.liftIO $ putStrLn $ "lookupSymbol::: continuing4..." let occNames = map nameOccName names :: [OccName] occNamesLookups = map (lookupGlobalRdrEnv gre) occNames :: [[GlobalRdrElt]] + GhcMonad.liftIO $ putStrLn $ "lookupSymbol::: continuing5..."+ return $ zip names occNamesLookups -- | List of possible modules which have resulted in@@ -407,7 +420,7 @@ -- -- >>> moduleOfQualifiedName "Foo.bar" -- Just "Foo"--- >>> moduleOfQualifiedName "bar"+-- >>> moduleOfQualifiedName "Foo" -- Nothing moduleOfQualifiedName :: QualifiedName -> Maybe String moduleOfQualifiedName qn = if null bits@@ -426,20 +439,15 @@ -- "Data.Map.Base.fromList [(\"x\", \"y\")]" -- "Data.Map.Base.fromList" -qualifiedName :: GhcOptions -> FilePath -> String -> Int -> Int -> [String] -> IO [String]-qualifiedName ghcopts targetFile targetModuleName lineNr colNr importList =- -- defaultErrorHandler defaultFatalMessager defaultFlushOut $- runGhc (Just libdir) $ do- _ <- getSessionDynFlags >>= setDynamicFlags ghcopts-- target <- guessTarget targetFile Nothing- setTargets [target]- _ <- load LoadAllTargets-+qualifiedName :: GhcOptions -> FilePath -> String -> Int -> Int -> [String] -> Ghc [String]+qualifiedName ghcopts targetFile targetModuleName lineNr colNr importList = do (setContext $ map (IIDecl . simpleImportDecl . mkModuleName) (targetModuleName:importList))- `gcatch` (\(_ :: SourceError) -> GhcMonad.liftIO $ putStrLn "qualifiedName: setContext failed with a SourceError, trying to continue anyway...")- `gcatch` (\(_ :: GhcApiError) -> GhcMonad.liftIO $ putStrLn "qualifiedName: setContext failed with a GhcApiError, trying to continue anyway...")- `gcatch` (\(_ :: SomeException) -> GhcMonad.liftIO $ putStrLn "qualifiedName: setContext failed with a SomeException, trying to continue anyway...")+ `gcatch` (\(s :: SourceError) -> do GhcMonad.liftIO $ putStrLn $ "qualifiedName: setContext failed with a SourceError, trying to continue anyway..." ++ show s+ setContext $ map (IIDecl . simpleImportDecl . mkModuleName) importList)+ `gcatch` (\(g :: GhcApiError) -> do GhcMonad.liftIO $ putStrLn $ "qualifiedName: setContext failed with a GhcApiError, trying to continue anyway..." ++ show g+ setContext $ map (IIDecl . simpleImportDecl . mkModuleName) importList)+ `gcatch` (\(se :: SomeException) -> do GhcMonad.liftIO $ putStrLn $ "qualifiedName: setContext failed with a SomeException, trying to continue anyway..." ++ show se+ setContext $ map (IIDecl . simpleImportDecl . mkModuleName) importList) modSummary <- getModSummary $ mkModuleName targetModuleName :: Ghc ModSummary p <- parseModule modSummary :: Ghc ParsedModule@@ -607,20 +615,23 @@ -- | 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] -> GhcPkgOptions -> (Name, [GlobalRdrElt]) -> IO (Maybe String, Maybe String, Maybe String, Maybe String)+findHaddockModule :: QualifiedName -> [HaskellModule] -> GhcPkgOptions -> (Name, [GlobalRdrElt]) -> IO [(Maybe String, Maybe String, Maybe String, Maybe String)] findHaddockModule symbol'' smatches ghcpkgOpts (name, lookUp) = do+ -- FIXME this is messy - the code below has a dodgy fromJust...+ if isJust (moduleOfQualifiedName symbol'')+ then do+ let lastBitOfSymbol = last $ separateBy '.' symbol''+ putStrLn $ "findHaddockModule, symbol'': " ++ symbol''+ putStrLn $ "findHaddockModule, lastBitOfSymbol: " ++ lastBitOfSymbol putStrLn $ "name: " ++ showSDoc tdflags (ppr name) let definedIn = nameModule name bpms = bestPrefixMatches name lookUp+ importedFrom :: [String] importedFrom = if null smatches- -- then Safe.headMay $ concatMap symbolImportedFrom lookUp :: Maybe ModuleName- -- FIXME should really return *all* of these matches, not just the first one. We- -- can't be certain that we're choosing the best one. Ditto for all other- -- uses of head or Safe.headMay.- then if null bpms then Safe.headMay $ map (showSDoc tdflags . ppr) $ concatMap symbolImportedFrom lookUp- else Safe.headMay bpms :: Maybe String- else (Just . (showSDoc tdflags . ppr) . mkModuleName . fromJust . moduleOfQualifiedName) symbol'' -- FIXME dangerous fromJust+ 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 putStrLn $ "definedIn: " ++ showSDoc tdflags (ppr definedIn) putStrLn $ "bpms: " ++ show bpms@@ -629,24 +640,32 @@ putStrLn $ "importedFrom: " ++ show importedFrom - foundModule <- maybe (return Nothing) (ghcPkgFindModule ghcpkgOpts) importedFrom- putStrLn $ "ghcPkgFindModule result: " ++ show foundModule+ forM importedFrom $ \impfrom -> do+ let impfrom' = Just impfrom+ foundModule <- maybe (return Nothing) (ghcPkgFindModule ghcpkgOpts) impfrom'+ putStrLn $ "ghcPkgFindModule result: " ++ show foundModule - let base = moduleNameToHtmlFile <$> importedFrom+ let base = moduleNameToHtmlFile <$> impfrom' - putStrLn $ "base: : " ++ show base+ putStrLn $ "base: : " ++ show base - -- haddock <- fmap (filter ('"' /=)) <$> maybe (return Nothing) (ghcPkgHaddockUrl ghcPkgOpts) foundModule- haddock <- maybe (return Nothing) (ghcPkgHaddockUrl ghcpkgOpts) foundModule+ haddock <- maybe (return Nothing) (ghcPkgHaddockUrl ghcpkgOpts) foundModule - putStrLn $ "haddock: " ++ show haddock- putStrLn $ "foundModule: " ++ show foundModule+ putStrLn $ "haddock: " ++ show haddock+ putStrLn $ "foundModule1: " ++ show foundModule - return (importedFrom, haddock, foundModule, base)+ return (impfrom', haddock, foundModule, base)+ else+ return [] -- | Convert our match to a URL, either @file://@ if the file exists, or to @hackage.org@ otherwise. matchToUrl :: (Maybe String, Maybe String, Maybe String, Maybe String) -> IO String matchToUrl (importedFrom, haddock, foundModule, base) = do+ when (isNothing importedFrom) $ error "importedFrom is Nothing :("+ when (isNothing haddock) $ error "haddock is Nothing :("+ when (isNothing foundModule) $ error "foundModule is Nothing :("+ when (isNothing base) $ error "base is Nothing :("+ let importedFrom' = fromJust importedFrom haddock' = fromJust haddock foundModule' = fromJust foundModule@@ -658,10 +677,70 @@ if e then return $ "file://" ++ f else do putStrLn $ "f: " ++ show f- putStrLn $ "foundModule: " ++ show foundModule'- return $ toHackageUrl f foundModule' (showSDoc tdflags (ppr importedFrom'))+ putStrLn $ "foundModule2: " ++ show foundModule'+ putStrLn $ "calling toHackageUrl with params: " ++ show (f, foundModule', importedFrom')+ return $ toHackageUrl f foundModule' importedFrom' +-- | The 'concatMapM' function generalizes 'concatMap' to arbitrary monads.+concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]+concatMapM f xs = liftM concat (mapM f xs)++isHidden :: String -> String -> HaskellModule -> Bool+isHidden symbol mname (HaskellModule name qualifier isImplicit hiding importedAs specifically) = mname == name && isNothing importedAs && symbol `elem` hiding++filterMatchingQualifiedImport :: String -> [HaskellModule] -> [HaskellModule]+filterMatchingQualifiedImport symbol hmodules =+ case moduleOfQualifiedName symbol of Nothing -> []+ asBit@(Just _) -> filter (\z -> asBit == modImportedAs z) hmodules++isInHiddenPackage :: GhcMonad m => String -> m Bool+isInHiddenPackage mName =+ (do setContext $ map (IIDecl . simpleImportDecl . mkModuleName) [mName]+ -- We were able to load the package, so it is not hidden.+ return False)+ `gcatch` (\(_ :: SourceError) -> do GhcMonad.liftIO $ putStrLn $ "isInHiddenPackage: module " ++ mName ++ " is in a hidden package."+ return True)+++finalCase :: [String] -> String -> String -> [Char] -> [[Char]] -> Ghc [String]+finalCase ghcOpts0 targetFile targetModule symbol haskellModuleNames' = do+ blah <- forM haskellModuleNames' $ \hm -> do fff <- lookupSymbol (GhcOptions ghcOpts0) targetFile targetModule (hm ++ "." ++ symbol) haskellModuleNames'+ if (length fff) > 0+ then do GhcMonad.liftIO $ putStrLn $ "finalCase: " ++ hm+ return [hm]+ else return []+ return $ concat blah++actualFinalCase ghcOpts0 ghcpkgOptions targetFile targetModule symbol haskellModuleNames' = do+ -- This is getting ridiculous...+ GhcMonad.liftIO $ putStrLn "last bits 1..."+ zzz <- finalCase ghcOpts0 targetFile targetModule symbol haskellModuleNames'+ GhcMonad.liftIO $ putStrLn "last bits 2..."+ yyy <- forM zzz $ \r -> do p <- GhcMonad.liftIO $ ghcPkgFindModule ghcpkgOptions r+ GhcMonad.liftIO $ print $ "forM_ last bits: " ++ show p+ case p of Nothing -> return []+ (Just _) -> return [(r, fromJust p)]++ let yyy' = concat yyy++ GhcMonad.liftIO $ putStrLn "last bits 3..."+ -- FIXME why don't we have the full ghc options right now? More than just the user-supplied ones?+ yyy'' <- forM yyy' $ \(mname, pname) -> do haddock <- GhcMonad.liftIO $ ghcPkgHaddockUrl (GhcPkgOptions ghcOpts0) pname+ if isJust haddock+ then do GhcMonad.liftIO $ putStrLn $ "last bits 3 inner loop: " ++ show haddock+ url <- GhcMonad.liftIO $ matchToUrl (Just mname, haddock, Just mname, Just $ moduleNameToHtmlFile mname)+ return $ Just url+ else return Nothing++ GhcMonad.liftIO $ putStrLn $ "yyy'': " ++ show yyy''++ GhcMonad.liftIO $ putStrLn "last bits 4..."+ let yyy''' = catMaybes yyy''+ GhcMonad.liftIO $ print $ "yyy''': " ++ (show yyy''')++ return yyy'''+ -- | Attempt to guess the Haddock url, either a local file path or url to @hackage.haskell.org@ -- for the symbol in the given file, module, at the specified line and column location. --@@ -671,7 +750,7 @@ -- (lots of output) -- SUCCESS: file:///home/carlo/opt/ghc-7.6.3_build/share/doc/ghc/html/libraries/base-4.6.0.1/Data-Maybe.html -guessHaddockUrl :: FilePath -> String -> Symbol -> Int -> Int -> GhcOptions -> GhcPkgOptions -> IO (Either String String)+guessHaddockUrl :: FilePath -> String -> Symbol -> Int -> Int -> GhcOptions -> GhcPkgOptions -> IO (Either String [String]) guessHaddockUrl _targetFile targetModule symbol lineNr colNr (GhcOptions ghcOpts0) ghcpkgOptions = do cradle <- findCradle let currentDir = cradleCurrentDir cradle@@ -689,50 +768,89 @@ putStrLn $ "ghcOpts0: " ++ show ghcOpts0 putStrLn $ "ghcpkgOptions: " ++ show ghcpkgOptions - textualImports <- getTextualImports (GhcOptions ghcOpts0) targetFile targetModule+ -- Put a runGhc up here, then change the types further down???+ runGhc (Just libdir) $ do+ textualImports <- getTextualImports (GhcOptions ghcOpts0) targetFile targetModule - let haskellModuleNames = map (modName . toHaskellModule) textualImports- putStrLn $ "haskellModuleNames: " ++ show haskellModuleNames+ let haskellModules0 = map toHaskellModule textualImports+ haskellModuleNames0 = map modName haskellModules0+ GhcMonad.liftIO $ putStrLn $ "haskellModuleNames0: " ++ show haskellModuleNames0+ GhcMonad.liftIO $ putStrLn $ "haskellModuleNames0 (full detail): " ++ show haskellModules0 - qnames <- filter (not . (' ' `elem`)) <$> qualifiedName (GhcOptions ghcOpts0) targetFile targetModule lineNr colNr haskellModuleNames+ -- If symbol is something like DM.lookup, then restrict haskellModuleNames to the+ -- one that has modImportedAs == Just "DM".+ let filterThings = filterMatchingQualifiedImport symbol haskellModules0+ let haskellModules = if null filterThings then haskellModules0 else filterThings+ let haskellModuleNames = if null filterThings then map modName haskellModules0 else map modName filterThings - putStrLn $ "qualified names: " ++ show qnames+ qnames <- filter (not . (' ' `elem`)) <$> qualifiedName (GhcOptions ghcOpts0) targetFile targetModule lineNr colNr haskellModuleNames - let matchingAsImport = expandMatchingAsImport symbol (map toHaskellModule textualImports)- putStrLn $ "matchingAsImport: " ++ show matchingAsImport+ GhcMonad.liftIO $ putStrLn $ "qualified names: " ++ show qnames - let postMatches = filter (postfixMatch symbol) qnames :: [String]- symbol' = fromMaybe (if null postMatches then symbol else minimumBy (compare `on` length) postMatches) matchingAsImport+ let matchingAsImport = expandMatchingAsImport symbol (map toHaskellModule textualImports)+ GhcMonad.liftIO $ putStrLn $ "matchingAsImport: " ++ show matchingAsImport - putStrLn $ "postMatches: " ++ show postMatches- putStrLn $ "symbol': " ++ symbol'+ let postMatches = filter (postfixMatch symbol) qnames :: [String]+ symbol' = fromMaybe (if null postMatches then symbol else minimumBy (compare `on` length) postMatches) matchingAsImport - let maybeExtraModule = moduleOfQualifiedName symbol'- haskellModuleNames' = if symbol == symbol' then haskellModuleNames else haskellModuleNames ++ [fromJust maybeExtraModule]+ GhcMonad.liftIO $ putStrLn $ "postMatches: " ++ show postMatches+ GhcMonad.liftIO $ putStrLn $ "symbol': " ++ symbol' - putStrLn $ "maybeExtraModule: " ++ show maybeExtraModule- putStrLn $ "haskellModuleNames': " ++ show haskellModuleNames'+ let maybeExtraModule = moduleOfQualifiedName symbol' - let smatches = specificallyMatches symbol (map toHaskellModule textualImports)- putStrLn $ "smatches: " ++ show smatches+ -- The module maybeExtraModule might be hidden. Check this.+ extraIsHidden <- case maybeExtraModule of Just x -> isInHiddenPackage x+ Nothing -> return False+ GhcMonad.liftIO $ putStrLn $ "extraIsHidden: " ++ show extraIsHidden - let symbol'' = if null smatches- then symbol'- else modName (head smatches) ++ "." ++ symbol+ let maybeExtraModule' = if extraIsHidden+ then []+ else if isJust maybeExtraModule+ then [fromJust maybeExtraModule]+ else [] - putStrLn $ "symbol'': " ++ symbol''+ let haskellModuleNames' = if symbol == symbol' then haskellModuleNames else haskellModuleNames ++ maybeExtraModule' - let allJust (a, b, c, d) = isJust a && isJust b && isJust c && isJust d+ GhcMonad.liftIO $ putStrLn $ "maybeExtraModule: " ++ show maybeExtraModule+ GhcMonad.liftIO $ putStrLn $ "maybeExtraModule': " ++ show maybeExtraModule'+ GhcMonad.liftIO $ putStrLn $ "haskellModuleNames': " ++ show haskellModuleNames' - final1 <- lookupSymbol (GhcOptions ghcOpts0) targetFile targetModule symbol'' haskellModuleNames'- final2 <- filter allJust <$> mapM (findHaddockModule symbol'' smatches ghcpkgOptions) final1 - final3 <- mapM matchToUrl final2+ let smatches = specificallyMatches symbol (map toHaskellModule textualImports)+ GhcMonad.liftIO $ putStrLn $ "smatches: " ++ show smatches - return (if null final3 then Left "No matches found."- else Right $ head final3)+ let symbol'' = if null smatches+ then symbol'+ else modName (head smatches) ++ "." ++ symbol + GhcMonad.liftIO $ putStrLn $ "symbol'': " ++ symbol'' + let allJust (a, b, c, d) = isJust a && isJust b && isJust c && isJust d++ -- Then this does a runGhc as well.+ final1 <- lookupSymbol (GhcOptions ghcOpts0) targetFile targetModule symbol'' haskellModuleNames'++ final1' <- GhcMonad.liftIO $ concatMapM (findHaddockModule symbol'' smatches ghcpkgOptions) final1+ GhcMonad.liftIO $ putStrLn $ "final1': " ++ show final1'++ -- Remove any modules that have this name hidden.+ -- e.g. import Data.List hiding (map)+ let final1'' = filter (\(a,_,_,_) -> case a of Just a' -> not $ any (isHidden symbol a') haskellModules+ Nothing -> False) final1'+ GhcMonad.liftIO $ putStrLn $ "final1'': " ++ show final1''+ GhcMonad.liftIO $ putStrLn $ show (symbol, haskellModules)++ let final2 = filter allJust final1''+ final3 <- GhcMonad.liftIO $ mapM matchToUrl final2++ GhcMonad.liftIO $ putStrLn "last bits 5..."+ if null final3+ then do yyy''' <- actualFinalCase ghcOpts0 ghcpkgOptions targetFile targetModule symbol haskellModuleNames'+ if null yyy'''+ then return $ Left $ "No matches found."+ else return $ Right yyy'''+ else return $ Right final3+ -- | Top level function; use this one from src/Main.hs. haddockUrl :: Options -> FilePath -> String -> String -> Int -> Int -> IO String haddockUrl opt file modstr symbol lineNr colNr = do@@ -741,11 +859,12 @@ let ghcpkgopts = GhcPkgOptions $ ghcPkgOpts opt res <- (guessHaddockUrl file modstr symbol lineNr colNr ghcopts ghcpkgopts)- `gcatch` (\(_ :: SourceError) -> return $ Left "guessHaddockUrl failed with a SourceError")- `gcatch` (\(_ :: GhcApiError) -> return $ Left "guessHaddockUrl failed with a GhcApiError")- `gcatch` (\(_ :: SomeException) -> return $ Left "guessHaddockUrl failed with a SomeException")-- return $ case res of Right x -> "SUCCESS: " ++ x ++ "\n"- Left err -> "FAIL: " ++ show err ++ "\n"-+ -- `gcatch` (\(s :: SourceError) -> return $ Left $ "guessHaddockUrl failed with a SourceError... " ++ show s)+ -- `gcatch` (\(g :: GhcApiError) -> return $ Left $ "guessHaddockUrl failed with a GhcApiError... " ++ show g)+ -- `gcatch` (\(se :: SomeException) -> return $ Left $ "guessHaddockUrl failed with a SomeException... " ++ show se) + case res of Right x -> return $ (if length x > 1 then "WARNING: Multiple matches! Showing them all.\n" else "")+ ++ (concat $ map (\z -> "SUCCESS: " ++ z ++ "\n") (reverse x)) -- Why reverse? To show the first one last, which the vim plugin will get.+ -- This is flaky but will make it behave as earlier versions did, which used+ -- Safe.headMay to get the first result.+ Left err -> return $ "FAIL: " ++ show err ++ "\n"
README.md view
@@ -63,8 +63,20 @@ cd ghc-imported-from ./build_in_sandbox.sh -Either way, ensure that ```ghc-imported-from``` is in the current PATH.+Either way, ensure that ```ghc-imported-from``` and ```fake-ghc-for-ghc-imported-from``` are in the current PATH. +### Tests++Run the tests using cabal:++ cabal test --show-details=streaming++As of 2014-05-18 just running ```cabal test``` seems to run the+tests and then hang (waiting on a PID). This seems to be the problem:+https://github.com/haskell/cabal/issues/1810++Running with ```--show-details=streaming``` seems to work ok.+ ### ghcimportedfrom-vim Follow the instructions at@@ -78,3 +90,19 @@ Or watch the screencast (be sure to set 720p HD and then fullscreen): [http://www.youtube.com/watch?v=VVc8uupYJGs](http://www.youtube.com/watch?v=VVc8uupYJGs)++## Notes++```ghc-imported-from``` uses both GHC and ghc-pkg, which+accept arguments in differing formats. For example GHC takes+```-package-db``` while ghc-pkg takes ```--package-db=```. For more+details: http://www.vex.net/~trebla/haskell/sicp.xhtml++## Debugging++To see the GHC options that have been automatically detected, change into your project's directory and run:++ $ cd ~/ghc-imported-from+ $ cabal repl --with-ghc=fake-ghc-for-ghc-imported-from+ Preprocessing library ghc-imported-from-0.2.0.2...+ --interactive -fbuilding-cabal-package -O0 -outputdir dist/build -odir dist/build -hidir dist/build -stubdir dist/build -i -idist/build -i. -idist/build/autogen -Idist/build/autogen -Idist/build -optP-include -optPdist/build/autogen/cabal_macros.h -package-name ghc-imported-from-0.2.0.2 -hide-all-packages -no-user-package-db -package-db /home/user/ghc-imported-from/.cabal-sandbox/x86_64-linux-ghc-7.6.3-packages.conf.d -package-db dist/package.conf.inplace -package-id Cabal-1.16.0-c6e09e008cd04cf255c1ce0c59aba905 -package-id base-4.6.0.1-8aa5d403c45ea59dcd2c39f123e27d57 -package-id containers-0.5.0.0-ab1dae9a94cd3cc84e7b2805636ebfa2 -package-id directory-1.2.0.1-91a788fd88acd7f149f0f10f5f1e23f2 -package-id filepath-1.3.0.1-b12cbe18566fe1532a1fda4c85e31cbe -package-id ghc-7.6.3-18957ddbb817289f604552aa2da2e879 -package-id ghc-mod-4.1.0-a87501f2667239b3f0bef3e0f3753496 -package-id ghc-paths-0.1.0.9-3817f31ae510ed3b58554933ea527b74 -package-id ghc-syb-utils-0.2.1.2-bf72c1e71339c52f0af404a12449c9d2 -package-id mtl-2.2.0.1-ef91e0abcf7a4fb581ecb7fe83cdcba1 -package-id process-1.1.0.2-76e05340eb66705981411022731ca84a -package-id safe-0.3.4-ba52ca348aecad429ba90450e3aba4c4 -package-id syb-0.4.1-9469ffdd9c6a7ebbf035421c915a08ee -package-id transformers-0.4.1.0-42810d723884ebf2a2dd638e5b22e523 -XHaskell2010 Language.Haskell.GhcImportedFrom Language.Haskell.GhcImportedFrom.UtilsFromGhcMod Language.Haskell.GhcImportedFrom.Types -Wall
changelog.md view
@@ -1,3 +1,8 @@+2014-05-16 v0.2.0.3++* Fixed test cases.+* Added alternative heuristic for lookup.+ 2014-05-16 v0.2.0.2 * Catch GHC panics.
ghc-imported-from.cabal view
@@ -1,5 +1,5 @@ name: ghc-imported-from-version: 0.2.0.2+version: 0.2.0.3 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.@@ -19,6 +19,7 @@ test/data/*.hs library+ GHC-Options: -Wall -O2 exposed-modules: Language.Haskell.GhcImportedFrom other-modules: Language.Haskell.GhcImportedFrom.UtilsFromGhcMod Language.Haskell.GhcImportedFrom.Types@@ -46,7 +47,7 @@ executable fake-ghc-for-ghc-imported-from main-is: fake-ghc-for-ghc-imported-from.hs- GHC-Options: -Wall+ GHC-Options: -Wall -O2 hs-source-dirs: src build-depends: base >=4.6 && <4.8 , process@@ -54,7 +55,7 @@ executable ghc-imported-from main-is: Main.hs- GHC-Options: -Wall+ GHC-Options: -Wall -O2 other-modules: Paths_ghc_imported_from other-extensions: CPP, Rank2Types build-depends: base >=4.6 && <4.8@@ -83,7 +84,7 @@ Test-Suite spec Default-Language: Haskell2010- GHC-Options: -Wall+ GHC-Options: -Wall -O2 Main-Is: Spec.hs Hs-Source-Dirs: test, . Type: exitcode-stdio-1.0
test/ImportedFromSpec.hs view
@@ -12,6 +12,9 @@ isRight :: forall a b. Either a b -> Bool isRight = either (const False) (const True) +-- Instead of shouldSatisfy isRight, these should check for the right module/package+-- name turning up in the results.+ spec :: Spec spec = do describe "checkImportedFrom" $ do@@ -62,15 +65,16 @@ it "can look up map" $ do withDirectory_ "test/data" $ do- res <- guessHaddockUrl "Hiding.hs" "Hiding" "map" 12 5 (GhcOptions []) (GhcPkgOptions [])+ res <- guessHaddockUrl "Hiding.hs" "Hiding" "map" 14 5 (GhcOptions []) (GhcPkgOptions []) res `shouldSatisfy` isRight it "can look up head" $ do withDirectory_ "test/data" $ do- res <- guessHaddockUrl "Hiding.hs" "Hiding" "head" 12 5 (GhcOptions []) (GhcPkgOptions [])+ res <- guessHaddockUrl "Hiding.hs" "Hiding" "head" 16 5 (GhcOptions []) (GhcPkgOptions []) res `shouldSatisfy` isRight it "can look up when" $ do withDirectory_ "test/data" $ do res <- guessHaddockUrl "When.hs" "When" "when" 15 5 (GhcOptions []) (GhcPkgOptions []) res `shouldSatisfy` isRight+