ghc-imported-from 0.1.0.1 → 0.1.0.2
raw patch · 6 files changed
+282/−41 lines, 6 files
Files
- Language/Haskell/GhcImportedFrom.hs +60/−4
- Language/Haskell/GhcImportedFrom/Types.hs +22/−0
- Language/Haskell/GhcImportedFrom/UtilsFromGhcMod.hs +69/−1
- README.md +31/−12
- ghc-imported-from.cabal +3/−2
- src/Main.hs +97/−22
Language/Haskell/GhcImportedFrom.hs view
@@ -28,6 +28,7 @@ , ghcOptionToGhcPKg , getGhcOptionsViaGhcMod , getGHCOptionsViaCradle+ , getCompilerOptionsViaGhcMod , modifyDFlags , setDynamicFlags , getTextualImports@@ -48,6 +49,12 @@ , findHaddockModule , matchToUrl , guessHaddockUrl+ , haddockUrl++ -- Things from Language.Haskell.GhcImportedFrom.Types+ , Options (..)+ , defaultOptions+ , LineSeparator (..) ) where import Control.Applicative@@ -83,10 +90,22 @@ import qualified SrcLoc import qualified Safe -import Language.Haskell.GhcMod-import Language.Haskell.GhcMod.Internal+import Language.Haskell.GhcMod (+ findCradle+ , cradleCabalFile+ , cradleCabalDir+ , cradlePackageDbOpts+ ) +import Language.Haskell.GhcMod.Internal (+ cabalAllBuildInfo+ , GHCOption+ , parseCabalFile+ , CompilerOptions (..)+ )+ import Language.Haskell.GhcImportedFrom.UtilsFromGhcMod+import Language.Haskell.GhcImportedFrom.Types type QualifiedName = String -- ^ A qualified name, e.g. @Foo.bar@. @@ -131,6 +150,13 @@ let binfo = head $ cabalAllBuildInfo pkgDesc getGHCOptions [] c (fromJust $ cradleCabalDir c) binfo +-- | Get compiler options using ghc-mod's API.+getCompilerOptionsViaGhcMod :: [GHCOption] -> IO CompilerOptions+getCompilerOptionsViaGhcMod ghcOpts0 = do+ cradle <- findCradle+ pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile cradle+ getCompilerOptions ghcOpts0 cradle pkgDesc+ -- | Add user-supplied GHC options to those discovered via ghc-mod. modifyDFlags :: [String] -> DynFlags -> IO ([String], [GHCOption], DynFlags) modifyDFlags ghcOpts0 dflags0 =@@ -139,20 +165,32 @@ (GhcOptions ghcOpts1) <- GhcMonad.liftIO getGhcOptionsViaGhcMod ghcOpts2 <- GhcMonad.liftIO getGHCOptionsViaCradle + (CompilerOptions compGhcOpts iPaths coDepPkgs) <- GhcMonad.liftIO $ getCompilerOptionsViaGhcMod ghcOpts0++ -- FIXME Need to log this info.+ -- GhcMonad.liftIO $ putStrLn $ "compGhcOpts: " ++ show compGhcOpts+ -- GhcMonad.liftIO $ putStrLn $ "iPaths: " ++ show iPaths+ -- GhcMonad.liftIO $ putStrLn $ "coDepPkgs: " ++ show coDepPkgs+ -- FIXME need to add ghcOpts1 and ghcOpts2 to the WriterT, but here -- we are inside the GhcMonad, so need to do some transformer stuff. -- Instead we laboriously return ghcOpts1 and ghcOpts2 up the call chain. -- GhcMonad.liftIO $ putStrLn $ "ghcOpts1: " ++ show ghcOpts1 -- GhcMonad.liftIO $ putStrLn $ "ghcOpts2: " ++ show ghcOpts2 - (dflags1, _, _) <- GHC.parseDynamicFlags dflags0 (map SrcLoc.noLoc $ ghcOpts1 ++ ghcOpts2 ++ ghcOpts0)+ -- FIXME Can probably remove the ghcOpts1 and ghcOpts2 stuff which+ -- is superceded by the functionality of getCompilerOptionsViaGhcMod.+ (dflags1, _, _) <- GHC.parseDynamicFlags dflags0 (map SrcLoc.noLoc $ ghcOpts1 ++ ghcOpts2 ++ ghcOpts0 ++ compGhcOpts) let dflags2 = dflags1 { hscTarget = HscInterpreted , ghcLink = LinkInMemory+ , importPaths = iPaths } - return (ghcOpts1, ghcOpts2, dflags2)+ dflags3 = addDevPkgs dflags2 coDepPkgs + return (ghcOpts1, ghcOpts2, dflags3)+ -- | Set GHC options and run 'initPackages' in 'GhcMonad'. -- -- Typical use:@@ -634,6 +672,9 @@ myTell $ "line nr: " ++ show lineNr myTell $ "col nr: " ++ show colNr + myTell $ "ghcOpts0: " ++ show ghcOpts0+ myTell $ "ghcPkgOpts: " ++ show ghcPkgOpts+ textualImports <- getTextualImports (GhcOptions ghcOpts0) targetFile targetModule let haskellModuleNames = map (modName . toHaskellModule) textualImports@@ -676,3 +717,18 @@ return (if null final3 then Left "No matches found." else Right $ head 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++ let ghcopts = GhcOptions $ ghcOpts opt+ let ghcpkgopts = GhcPkgOptions $ ghcPkgOpts opt++ (res, logMessages) <- runWriterT $ guessHaddockUrl file modstr symbol lineNr colNr ghcopts ghcpkgopts++ return $ case res of Right x -> unlines logMessages ++ "SUCCESS: " ++ x ++ "\n"+ Left err -> "FAIL: " ++ show err ++ "\n"++
+ Language/Haskell/GhcImportedFrom/Types.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE FlexibleInstances #-}++-- Adapted from ghc-mod/Language/Haskell/GhcMod/Types.hs++module Language.Haskell.GhcImportedFrom.Types where++-- FIXME We don't support LineSeparator; might be handy for+-- Windows (?) with CRLF encoding?+newtype LineSeparator = LineSeparator String deriving (Show)++data Options = Options {+ ghcOpts :: [String]+ , ghcPkgOpts :: [String]+ , lineSeparator :: LineSeparator+ } deriving (Show)++defaultOptions :: Options+defaultOptions = Options {+ ghcOpts = []+ , ghcPkgOpts = []+ , lineSeparator = LineSeparator "\0"+ }
Language/Haskell/GhcImportedFrom/UtilsFromGhcMod.hs view
@@ -1,5 +1,6 @@-{-# LANGUAGE Rank2Types, OverloadedStrings #-}+{-# LANGUAGE Rank2Types, OverloadedStrings, CPP #-} + ----------------------------------------------------------------------------- -- | -- Module : UtilsFromGhcMod@@ -19,6 +20,8 @@ -- * <https://github.com/kazu-yamamoto/ghc-mod> -- -- Hopefully this is ok since ghc-mod and this project are both licensed BSD3.+-- If this package ever stabilises I may send a pull request to ghc-mod asking+-- for some of these functions to be exported, perhaps in Language.Haskell.GhcMod.Internal. module Language.Haskell.GhcImportedFrom.UtilsFromGhcMod where @@ -42,6 +45,10 @@ import Control.Exception (throwIO) +import Data.Set (fromList, toList)++import DynFlags+ -- ghcmod/Language/Haskell/GhcMod/Info.hs listifySpans :: Typeable a => TypecheckedSource -> (Int, Int) -> [Located a] listifySpans tcs lc = listifyStaged TypeChecker p tcs@@ -86,3 +93,64 @@ case mv of Nothing -> throwIO $ userError "ghc not found" Just v -> return v++-- ghc-mod/Language/Haskell/GhcMod/CabalApi.hs+getCompilerOptions :: [GHCOption] -> Cradle -> PackageDescription -> IO CompilerOptions+getCompilerOptions ghcopts cradle pkgDesc = do+ gopts <- getGHCOptions ghcopts cradle cdir $ head buildInfos+ return $ CompilerOptions gopts idirs depPkgs+ where+ wdir = cradleCurrentDir cradle+ Just cdir = cradleCabalDir cradle+ Just cfile = cradleCabalFile cradle+ buildInfos = cabalAllBuildInfo pkgDesc+ idirs = includeDirectories cdir wdir $ cabalSourceDirs buildInfos+ depPkgs = removeThem problematicPackages $ removeMe cfile $ cabalDependPackages buildInfos++-- ghc-mod/Language/Haskell/GhcMod/CabalApi.hs+removeMe :: FilePath -> [Package] -> [Package]+removeMe cabalfile = filter (/= me)+ where+ me = dropExtension $ takeFileName cabalfile++-- ghc-mod/Language/Haskell/GhcMod/CabalApi.hs+removeThem :: [Package] -> [Package] -> [Package]+removeThem badpkgs = filter (`notElem` badpkgs)++-- ghc-mod/Language/Haskell/GhcMod/CabalApi.hs+problematicPackages :: [Package]+problematicPackages = [+ "base-compat" -- providing "Prelude"+ ]++-- ghc-mod/Language/Haskell/GhcMod/CabalApi.hs+cabalBuildDirs :: [FilePath]+cabalBuildDirs = ["dist/build", "dist/build/autogen"]++-- ghc-mod/Language/Haskell/GhcMod/CabalApi.hs+includeDirectories :: FilePath -> FilePath -> [FilePath] -> [FilePath]+includeDirectories cdir wdir dirs = uniqueAndSort (extdirs ++ [cdir,wdir])+ where+ extdirs = map expand $ dirs ++ cabalBuildDirs+ expand "." = cdir+ expand subdir = cdir </> subdir++-- ghc-mod/Language/Haskell/GhcMod/CabalApi.hs+uniqueAndSort :: [String] -> [String]+uniqueAndSort = toList . fromList++-- ghc-mod/Language/Haskell/GhcMod/Gap.hs+addDevPkgs :: DynFlags -> [Package] -> DynFlags+addDevPkgs df [] = df+addDevPkgs df pkgs = df''+ where+#if __GLASGOW_HASKELL__ >= 707+ df' = gopt_set df Opt_HideAllPackages+#else+ df' = dopt_set df Opt_HideAllPackages+#endif+ df'' = df' {+ packageFlags = map ExposePackage pkgs ++ packageFlags df+ }++
README.md view
@@ -1,17 +1,16 @@-ghc-imported-from-=================+# ghc-imported-from For a given Haskell source file, determine the path to the Haddock documentation for a symbol at a particular line/col location. -Example: on the file [Muddle.hs](https://github.com/carlohamalainen/ghc-imported-from/blob/master/tests/Muddle.hs),+Example: on the file [src/Main.hs](https://github.com/carlohamalainen/ghc-imported-from/blob/master/src/Main.hs), - ../.cabal-sandbox/bin/ghc-imported-from Muddle.hs Muddle Maybe 11 11+ ghc-imported-from haddock-url src/Main.hs Main getArgs 160 13 says - SUCCESS: /home/carlo/opt/ghc-7.6.3_build/share/doc/ghc/html/libraries/base-4.6.0.1/Data-Maybe.html+ SUCCESS: file:///home/carlo/opt/ghc-7.6.3_build/share/doc/ghc/html/libraries/base-4.6.0.1/System-Environment.html -since the usage of ```Maybe``` at line 11, column 11, is from the ```Data.Maybe``` module.+since the usage of ```getArgs``` at line 160, column 13, is from the ```System.Environment``` module. Difficulties arise because some symbols are exported from a certain package but defined in another, for example ```String``` is defined in@@ -22,6 +21,32 @@ Preference is given to any locally available Haddock documentation, and then to the generic url at hackage.org. +## Beware++You may have to run++ cabal build++or++ cabal repl++in a project directory to sort out some of the ```dist/build/autogen```+files. At the moment ```ghc-imported-from``` has no functionality to+do this boot process automatically. To run ```cabal repl``` you might need+the latest Cabal from [https://github.com/haskell/cabal](https://github.com/haskell/cabal).++If you see++ <command line>: cannot satisfy -package hspec+ (use -v for more information)++then you may need the hspec and/or doctest packages:++ cabal install hspec doctest++Feedback and pull requests most welcome!+ ## Install ### ghc-imported-from@@ -53,9 +78,3 @@ 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)--## Beware--If you use Cabal sandboxes, you'll have to hardcode the path to the package config file. This is a known issue: [https://github.com/carlohamalainen/ghc-imported-from/issues/3](https://github.com/carlohamalainen/ghc-imported-from/issues/3)--Feedback and pull requests most welcome!
ghc-imported-from.cabal view
@@ -1,5 +1,5 @@ name: ghc-imported-from-version: 0.1.0.1+version: 0.1.0.2 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.@@ -20,6 +20,7 @@ library exposed-modules: Language.Haskell.GhcImportedFrom other-modules: Language.Haskell.GhcImportedFrom.UtilsFromGhcMod+ Language.Haskell.GhcImportedFrom.Types other-extensions: CPP, Rank2Types build-depends: base >=4.6 && <4.7@@ -45,7 +46,7 @@ executable ghc-imported-from main-is: Main.hs GHC-Options: -Wall- -- other-modules:+ other-modules: Paths_ghc_imported_from other-extensions: CPP, Rank2Types build-depends: base >=4.6 && <4.7 , syb >=0.4 && <0.5
src/Main.hs view
@@ -1,39 +1,114 @@+{-# LANGUAGE DeriveDataTypeable #-}+ import Language.Haskell.GhcImportedFrom import Data.List import Data.Maybe+import Data.Version ( showVersion ) import System.Environment-import System.IO() +import System.IO (hPutStr, hPutStrLn, stdout, stderr, hSetEncoding, utf8)+import System.Console.GetOpt+import System.Exit++import Control.Exception+import Data.Typeable+ import Control.Monad (forM_) import Control.Monad.Writer -main :: IO ()-main = do- args <- getArgs+import Paths_ghc_imported_from - -- quick and dirty argument parsing, no error checking- let targetFile = args !! 0- targetModule = args !! 1- symbol = args !! 2- lineNo = (read $ args !! 3) :: Int- colNo = (read $ args !! 4) :: Int- rest = drop 5 args+-- FIXME adapt these to ghc-imported-from+data GHCImportedFromError = SafeList+ | TooManyArguments String+ | NoSuchCommand String+ | CmdArg [String]+ | FileNotExist String deriving (Show, Typeable) - -- assert: rest !! 0 == "--ghc-options"+instance Exception GHCImportedFromError - let n = fromJust $ elemIndex "--ghc-pkg-options" rest+ghcOptHelp :: String+ghcOptHelp = " [--ghc-option GHC_opt1 --ghc-option GHC_opt2 ...] " - -- assert: rest !! n == "--ghc-pkg-options"+ghcPkgOptHelp :: String+ghcPkgOptHelp = " [--ghc-pkg-option ghc_pkg_opt1 --ghc-pkg-option ghc_pkg_opt2 ...] " - let ghcopts = GhcOptions $ tail $ take n rest- let ghcpkgopts = GhcPkgOptions $ drop (n + 1) rest+usage :: String+usage = "ghc-imported-from version " ++ showVersion version ++ "\n"+ ++ "Usage:\n"+ ++ "\t ghc-imported-from haddock-url" ++ ghcOptHelp ++ ghcPkgOptHelp ++ "<HaskellFile> <module> <symbol> <line-no> <column-no>\n"+ ++ "\t ghc-imported-from help\n"+ ++ "\nExample: ghc-imported-from haddock-url src/Main.hs Main getArgs 160 13\n" - print ghcopts- print ghcpkgopts+parseArgs :: [OptDescr (Options -> Options)] -> [String] -> (Options, [String])+parseArgs spec argv+ = case getOpt Permute spec argv of+ (o,n,[] ) -> (foldr id defaultOptions o, n)+ (_,_,errs) -> throw (CmdArg errs) - (res, logMessages) <- runWriterT $ guessHaddockUrl targetFile targetModule symbol lineNo colNo ghcopts ghcpkgopts+argspec :: [OptDescr (Options -> Options)]+argspec = [ Option "g" ["ghc-options"]+ (ReqArg (\g opts -> opts { ghcOpts = g : ghcOpts opts }) "ghc-options")+ "GHC options"+ , Option "p" ["ghc-pkg-options"]+ (ReqArg (\g opts -> opts { ghcPkgOpts = g : ghcPkgOpts opts }) "ghc-pkg-options")+ "ghc-pkg options"+ -- , Option "b" ["boundary"]+ -- (ReqArg (\s opts -> opts { lineSeparator = LineSeparator s }) "sep")+ -- "specify line separator (default is Nul string)"+ ] - case res of Right x -> do forM_ logMessages putStrLn- putStrLn $ "SUCCESS: " ++ x- Left err -> putStrLn $ "FAIL: " ++ show err+main :: IO ()+main = flip catches handlers $ do+-- #if __GLASGOW_HASKELL__ >= 611+ hSetEncoding stdout utf8+-- #endif+ args <- getArgs+ let (opt,cmdArg) = parseArgs argspec args++ -- print opt+ -- print cmdArg++ let cmdArg0 = cmdArg !. 0+ cmdArg1 = cmdArg !. 1+ cmdArg2 = cmdArg !. 2+ cmdArg3 = cmdArg !. 3+ cmdArg4 = cmdArg !. 4+ cmdArg5 = cmdArg !. 5+ remainingArgs = tail cmdArg+ nArgs n f = if length remainingArgs == n+ then f+ else throw (TooManyArguments cmdArg0)++ res <- case cmdArg0 of+ "haddock-url" -> nArgs 5 $ haddockUrl opt cmdArg1 cmdArg2 cmdArg3 (read cmdArg4) (read cmdArg5)+ "help" -> return $ usageInfo usage argspec+ cmd -> throw (NoSuchCommand cmd)+ putStr res++ where+ handlers = [Handler (handleThenExit handler1), Handler (handleThenExit handler2)]+ handleThenExit handler = \e -> handler e >> exitFailure+ handler1 :: ErrorCall -> IO ()+ handler1 = print -- for debug+ handler2 :: GHCImportedFromError -> IO ()+ handler2 SafeList = printUsage+ handler2 (TooManyArguments cmd) = do+ hPutStrLn stderr $ "\"" ++ cmd ++ "\": Too many arguments"+ printUsage+ handler2 (NoSuchCommand cmd) = do+ hPutStrLn stderr $ "\"" ++ cmd ++ "\" not supported"+ printUsage+ handler2 (CmdArg errs) = do+ mapM_ (hPutStr stderr) errs+ printUsage+ handler2 (FileNotExist file) = do+ hPutStrLn stderr $ "\"" ++ file ++ "\" not found"+ printUsage+ printUsage = hPutStrLn stderr $ '\n' : usageInfo usage argspec++ xs !. idx+ | length xs <= idx = throw SafeList+ | otherwise = xs !! idx+