ghc-imported-from 0.2.0.3 → 0.2.0.4

raw patch · 4 files changed

+79/−51 lines, 4 filesdep +parsecPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: parsec

API changes (from Hackage documentation)

Files

• Language/Haskell/GhcImportedFrom.hs +61/−38
• README.md +4/−7
• changelog.md +6/−1
• ghc-imported-from.cabal +8/−5

@@ -97,6 +97,9 @@  import Control.Exception (SomeException) +import qualified Text.Parsec as TP+import Data.Functor.Identity+ #if __GLASGOW_HASKELL__ >= 708 import DynFlags ( unsafeGlobalDynFlags ) tdflags = unsafeGlobalDynFlags@@ -109,6 +112,8 @@  getGhcOptionsViaCabalRepl :: IO (Maybe [String]) getGhcOptionsViaCabalRepl = do+    putStrLn $ "getGhcOptionsViaCabalRepl..."+     (Just _, Just hout, Just _, _) <- createProcess (proc "cabal" ["repl", "--with-ghc=fake-ghc-for-ghc-imported-from"]){ std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }      ineof <- hIsEOF hout@@ -126,12 +131,35 @@     case length result' of 1 -> return $ Just $ filterOpts $ words $ head result'                            _ -> return Nothing -    where filterOpts :: [String] -> [String]-          filterOpts xs = filter (\x -> x /= "--interactive" && x /= "-fbuilding-cabal-package") $ dropModuleNames xs+filterOpts :: [String] -> [String]+filterOpts xs = filter (\x -> x /= "--interactive" && x /= "-fbuilding-cabal-package" && x /= "-Wall") $ dropModuleNames xs -          dropModuleNames :: [String] -> [String]-          dropModuleNames xs = reverse $ dropWhile (not . ("-" `isPrefixOf`)) (reverse xs)+dropModuleNames :: [String] -> [String]+dropModuleNames = filter parseHelper +parseHaskellModuleName :: TP.ParsecT String u Data.Functor.Identity.Identity String+parseHaskellModuleName = do+    c <- TP.upper+    cs <- TP.many (TP.choice [TP.lower, TP.upper])+    return (c:cs)++parseDottedHaskellModuleName :: TP.ParsecT String u Data.Functor.Identity.Identity String+parseDottedHaskellModuleName = do+    TP.char '.'+    cs <- parseHaskellModuleName+    return cs++parseFullHaskellModuleName :: TP.ParsecT String u Data.Functor.Identity.Identity String+parseFullHaskellModuleName = do+    h <- parseHaskellModuleName+    rest <- many parseDottedHaskellModuleName++    return $ intercalate "." (h:rest)++parseHelper :: String -> Bool+parseHelper s = case (TP.parse (parseFullHaskellModuleName <* TP.eof) "" s) of Right _ -> False+                                                                               Left _  -> True+ getGhcOptionsViaCabalReplOrEmpty :: IO [String] getGhcOptionsViaCabalReplOrEmpty =  liftM (fromMaybe []) getGhcOptionsViaCabalRepl @@ -159,7 +187,7 @@                     } deriving (Show, Eq)  -- | Add user-supplied GHC options to those discovered via cabl repl.-modifyDFlags :: [String] -> DynFlags -> IO ([String], [GHCOption], DynFlags)+modifyDFlags :: [String] -> DynFlags -> IO ([GHCOption], DynFlags) modifyDFlags ghcOpts0 dflags0 =     -- defaultErrorHandler defaultFatalMessager defaultFlushOut $         runGhc (Just libdir) $ do@@ -171,7 +199,7 @@                                   , ghcLink = LinkInMemory                                   } -            return ([], [], dflags2)+            return (ghcOpts0 ++ ghcOpts1, dflags2)  -- | Set GHC options and run 'initPackages' in 'GhcMonad'. --@@ -181,14 +209,14 @@ -- >    runGhc (Just libdir) $ do -- >        getSessionDynFlags >>= setDynamicFlags (GhcOptions myGhcOptionList) -- >        -- do stuff-setDynamicFlags :: GhcMonad m => GhcOptions -> DynFlags -> m ([String], [GHCOption], DynFlags)+setDynamicFlags :: GhcMonad m => GhcOptions -> DynFlags -> m ([GHCOption], DynFlags) setDynamicFlags (GhcOptions extraGHCOpts) dflags0 = do-    (ghcOpts1, ghcOpts2, dflags1) <- GhcMonad.liftIO $ modifyDFlags extraGHCOpts dflags0+    (allGhcOpts, dflags1) <- GhcMonad.liftIO $ modifyDFlags extraGHCOpts dflags0      void $ setSessionDynFlags dflags1     _ <- GhcMonad.liftIO $ Packages.initPackages dflags1 -    return (ghcOpts1, ghcOpts2, dflags1)+    return (allGhcOpts, dflags1)  -- |Read the textual imports in a file. --@@ -202,27 +230,27 @@ -- -- See also 'toHaskellModule' and 'getSummary'. -getTextualImports :: GhcMonad m => GhcOptions -> FilePath -> String -> m [SrcLoc.Located (ImportDecl RdrName)]+getTextualImports :: GhcMonad m => GhcOptions -> FilePath -> String -> m ([GHCOption], [SrcLoc.Located (ImportDecl RdrName)]) getTextualImports ghcopts targetFile targetModuleName = do     GhcMonad.liftIO $ putStrLn $ "getTextualImports: " ++ show (targetFile, targetModuleName)-    (ghcOpts1, ghcOpts2, modSum) <- getSummary ghcopts targetFile targetModuleName+    (allGhcOpts, modSum) <- getSummary ghcopts targetFile targetModuleName -    GhcMonad.liftIO $ putStrLn $ "getTextualImports: ghcOpts1: " ++ show ghcOpts1-    GhcMonad.liftIO $ putStrLn $ "getTextualImports: ghcOpts2: " ++ show ghcOpts2+    GhcMonad.liftIO $ putStrLn $ "getTextualImports: allGhcOpts: " ++ show allGhcOpts -    return $ ms_textual_imps modSum+    return (allGhcOpts, 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 :: GhcMonad m => GhcOptions -> FilePath -> String -> m ([String], [GHCOption], ModSummary)+getSummary :: GhcMonad m => GhcOptions -> FilePath -> String -> m ([GHCOption], ModSummary) getSummary ghcopts targetFile targetModuleName = do             GhcMonad.liftIO $ putStrLn $ "getSummary, setting dynamic flags..."-            (ghcOpts1, ghcOpts2, _) <- getSessionDynFlags >>= setDynamicFlags ghcopts+            (allGhcOpts, _) <- getSessionDynFlags >>= setDynamicFlags ghcopts              -- Load the target file (e.g. "Muddle.hs").             GhcMonad.liftIO $ putStrLn $ "getSummary, loading the target file..."             target <- guessTarget targetFile Nothing             setTargets [target]+             _ <- load LoadAllTargets              -- Set the context by loading the module, e.g. "Muddle" which is in "Muddle.hs".@@ -242,7 +270,7 @@             -- let graph_names = map (GHC.moduleNameString . GHC.ms_mod_name) graph             -- GhcMonad.liftIO $ print $ "graph_names: " ++ show graph_names -            return (ghcOpts1, ghcOpts2, modSum)+            return (allGhcOpts, modSum)  -- |Convenience function for converting an 'GHC.ImportDecl' to a 'HaskellModule'. --@@ -484,11 +512,9 @@  -- | Call @ghc-pkg find-module@ to determine that package that provides a module, e.g. @Prelude@ is defined -- in @base-4.6.0.1@.-ghcPkgFindModule :: GhcPkgOptions -> String -> IO (Maybe String)-ghcPkgFindModule (GhcPkgOptions extraGHCPkgOpts) m = do-    gopts <- getGhcOptionsViaCabalReplOrEmpty--    let opts = ["find-module", m, "--simple-output"] ++ ["--global", "--user"] ++ optsForGhcPkg gopts ++ extraGHCPkgOpts+ghcPkgFindModule :: [String] -> GhcPkgOptions -> String -> IO (Maybe String)+ghcPkgFindModule allGhcOptions (GhcPkgOptions extraGHCPkgOpts) m = do+    let opts = ["find-module", m, "--simple-output"] ++ ["--global", "--user"] ++ optsForGhcPkg allGhcOptions ++ extraGHCPkgOpts     putStrLn $ "ghc-pkg " ++ show opts      (_, Just hout, Just herr, _) <- createProcess (proc "ghc-pkg" opts){ std_in  = CreatePipe@@ -505,11 +531,9 @@     return $ join $ Safe.lastMay <$> words <$> (Safe.lastMay . lines) output  -- | Call @ghc-pkg field@ to get the @haddock-html@ field for a package.-ghcPkgHaddockUrl :: GhcPkgOptions -> String -> IO (Maybe String)-ghcPkgHaddockUrl (GhcPkgOptions extraGHCPkgOpts) p = do-    gopts <- getGhcOptionsViaCabalReplOrEmpty--    let opts = ["field", p, "haddock-html"] ++ ["--global", "--user"] ++ optsForGhcPkg gopts ++ extraGHCPkgOpts+ghcPkgHaddockUrl :: [String] -> GhcPkgOptions -> String -> IO (Maybe String)+ghcPkgHaddockUrl allGhcOptions (GhcPkgOptions extraGHCPkgOpts) p = do+    let opts = ["field", p, "haddock-html"] ++ ["--global", "--user"] ++ optsForGhcPkg allGhcOptions ++ extraGHCPkgOpts     putStrLn $ "ghc-pkg "++ show opts      (_, Just hout, _, _) <- createProcess (proc "ghc-pkg" opts){ std_in = CreatePipe@@ -615,8 +639,8 @@  -- | 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 symbol'' smatches ghcpkgOpts (name, lookUp) = do+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...  if isJust (moduleOfQualifiedName symbol'')   then do@@ -642,14 +666,14 @@      forM importedFrom $ \impfrom -> do         let impfrom' = Just impfrom-        foundModule <- maybe (return Nothing) (ghcPkgFindModule ghcpkgOpts) impfrom'+        foundModule <- maybe (return Nothing) (ghcPkgFindModule allGhcOpts ghcpkgOpts) impfrom'         putStrLn $ "ghcPkgFindModule result: " ++ show foundModule          let base = moduleNameToHtmlFile <$> impfrom'          putStrLn $ "base: : " ++ show base -        haddock <- maybe (return Nothing) (ghcPkgHaddockUrl ghcpkgOpts) foundModule+        haddock <- maybe (return Nothing) (ghcPkgHaddockUrl allGhcOpts ghcpkgOpts) foundModule          putStrLn $ "haddock: " ++ show haddock         putStrLn $ "foundModule1: " ++ show foundModule@@ -712,12 +736,12 @@                                                     else return []     return $ concat blah -actualFinalCase ghcOpts0 ghcpkgOptions targetFile targetModule symbol haskellModuleNames' = do+actualFinalCase allGhcOpts ghcpkgOptions targetFile targetModule symbol haskellModuleNames' = do     -- This is getting ridiculous...     GhcMonad.liftIO $ putStrLn "last bits 1..."-    zzz <- finalCase ghcOpts0 targetFile targetModule symbol haskellModuleNames'+    zzz <- finalCase allGhcOpts targetFile targetModule symbol haskellModuleNames'     GhcMonad.liftIO $ putStrLn "last bits 2..."-    yyy <- forM zzz $ \r -> do p <- GhcMonad.liftIO $ ghcPkgFindModule ghcpkgOptions r+    yyy <- forM zzz $ \r -> do p <- GhcMonad.liftIO $ ghcPkgFindModule allGhcOpts ghcpkgOptions r                                GhcMonad.liftIO $ print $ "forM_ last bits: " ++ show p                                case p of Nothing  -> return []                                          (Just _) -> return [(r, fromJust p)]@@ -726,7 +750,7 @@      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+    yyy'' <- forM yyy' $ \(mname, pname) -> do haddock <- GhcMonad.liftIO $ ghcPkgHaddockUrl allGhcOpts (GhcPkgOptions allGhcOpts) 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)@@ -770,7 +794,7 @@      -- Put a runGhc up here, then change the types further down???     runGhc (Just libdir) $ do-        textualImports <- getTextualImports (GhcOptions ghcOpts0) targetFile targetModule+        (allGhcOpts, textualImports) <- getTextualImports (GhcOptions ghcOpts0) targetFile targetModule          let haskellModules0 = map toHaskellModule textualImports             haskellModuleNames0 = map modName haskellModules0@@ -815,7 +839,6 @@         GhcMonad.liftIO $ putStrLn $ "maybeExtraModule': " ++ show maybeExtraModule'         GhcMonad.liftIO $ putStrLn $ "haskellModuleNames': " ++ show haskellModuleNames' -         let smatches = specificallyMatches symbol (map toHaskellModule textualImports)         GhcMonad.liftIO $ putStrLn $ "smatches: " ++ show smatches @@ -830,7 +853,7 @@         -- Then this does a runGhc as well.         final1 <- lookupSymbol (GhcOptions ghcOpts0) targetFile targetModule symbol'' haskellModuleNames' -        final1' <- GhcMonad.liftIO $ concatMapM (findHaddockModule symbol'' smatches ghcpkgOptions) final1+        final1' <- GhcMonad.liftIO $ concatMapM (findHaddockModule symbol'' smatches allGhcOpts ghcpkgOptions) final1         GhcMonad.liftIO $ putStrLn $ "final1': " ++ show final1'          -- Remove any modules that have this name hidden.

@@ -69,13 +69,10 @@  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+    cabal test -Running with ```--show-details=streaming``` seems to work ok.+If the tests hang, check that your version of Cabal/cabal-install has this+fix: https://github.com/haskell/cabal/issues/1810  ### ghcimportedfrom-vim @@ -89,7 +86,7 @@  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)+[https://www.youtube.com/watch?v=7yO_VGCWMu8](https://www.youtube.com/watch?v=7yO_VGCWMu8)  ## Notes 

@@ -1,4 +1,9 @@-2014-05-16 v0.2.0.3+2014-05-22 v0.2.0.4++* Speedup: factor out calls to getGhcOptionsViaCabalRepl.+* Bug fix: filter out haskell module names from the cabal options list.++2014-05-19 v0.2.0.3  * Fixed test cases. * Added alternative heuristic for lookup.

@@ -1,5 +1,5 @@ name:                ghc-imported-from-version:             0.2.0.3+version:             0.2.0.4 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,7 +19,7 @@                      test/data/*.hs  library-    GHC-Options:         -Wall -O2+    GHC-Options:         -Wall     exposed-modules: Language.Haskell.GhcImportedFrom     other-modules:   Language.Haskell.GhcImportedFrom.UtilsFromGhcMod                      Language.Haskell.GhcImportedFrom.Types@@ -38,6 +38,7 @@                  , containers                  , mtl                  , transformers+                 , parsec     if impl(ghc < 7.7)       Build-Depends:  Cabal >= 1.10 && < 1.17     else@@ -47,7 +48,7 @@  executable fake-ghc-for-ghc-imported-from   main-is:          fake-ghc-for-ghc-imported-from.hs-  GHC-Options:      -Wall -O2+  GHC-Options:      -Wall   hs-source-dirs:   src   build-depends: base >=4.6 && <4.8                , process@@ -55,7 +56,7 @@  executable ghc-imported-from   main-is:             Main.hs-  GHC-Options:         -Wall -O2+  GHC-Options:         -Wall   other-modules:        Paths_ghc_imported_from   other-extensions:    CPP, Rank2Types   build-depends: base >=4.6 && <4.8@@ -72,6 +73,7 @@                , containers                , mtl                , transformers+               , parsec                , hspec    if impl(ghc < 7.7)@@ -84,7 +86,7 @@  Test-Suite spec   Default-Language:     Haskell2010-  GHC-Options:          -Wall -O2+  GHC-Options:          -Wall   Main-Is:              Spec.hs   Hs-Source-Dirs:       test, .   Type:                 exitcode-stdio-1.0@@ -103,6 +105,7 @@                       , containers                       , mtl                       , transformers+                      , parsec                       , hspec   if impl(ghc < 7.7)       Build-Depends:  Cabal >= 1.10 && < 1.17