ghc-imported-from 0.1.0.4 → 0.2.0.0
raw patch · 5 files changed
+138/−288 lines, 5 filesdep ~basedep ~containersdep ~ghcnew-component:exe:fake-ghc-for-ghc-imported-fromPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, containers, ghc, ghc-mod, ghc-paths, syb
API changes (from Hackage documentation)
- Language.Haskell.GhcImportedFrom: getCompilerOptionsViaGhcMod :: [GHCOption] -> IO CompilerOptions
- Language.Haskell.GhcImportedFrom: getGHCOptionsViaCradle :: IO [GHCOption]
- Language.Haskell.GhcImportedFrom: getGhcOptionsViaGhcMod :: IO GhcOptions
- Language.Haskell.GhcImportedFrom: ghcOptionToGhcPKg :: [String] -> [String]
+ Language.Haskell.GhcImportedFrom: getGhcOptionsViaCabalRepl :: IO (Maybe [String])
Files
- Language/Haskell/GhcImportedFrom.hs +86/−88
- Language/Haskell/GhcImportedFrom/UtilsFromCabalInstall.hs +0/−46
- Language/Haskell/GhcImportedFrom/UtilsFromGhcMod.hs +0/−133
- ghc-imported-from.cabal +27/−21
- src/fake-ghc-for-ghc-imported-from.hs +25/−0
Language/Haskell/GhcImportedFrom.hs view
@@ -20,15 +20,11 @@ -- Latest development version: <https://github.com/carlohamalainen/ghc-imported-from>. module Language.Haskell.GhcImportedFrom (- QualifiedName(..)- , Symbol(..)+ QualifiedName+ , Symbol , GhcOptions(..) , GhcPkgOptions(..) , HaskellModule(..)- , ghcOptionToGhcPKg- , getGhcOptionsViaGhcMod- , getGHCOptionsViaCradle- , getCompilerOptionsViaGhcMod , modifyDFlags , setDynamicFlags , getTextualImports@@ -50,6 +46,7 @@ , matchToUrl , guessHaddockUrl , haddockUrl+ , getGhcOptionsViaCabalRepl -- Things from Language.Haskell.GhcImportedFrom.Types , Options (..)@@ -92,21 +89,52 @@ import Language.Haskell.GhcMod ( findCradle- , cradleCabalFile- , cradleCabalDir- , cradlePackageDbOpts- )--import Language.Haskell.GhcMod.Internal (- cabalAllBuildInfo- , GHCOption- , parseCabalFile- , CompilerOptions (..)+ , cradleRootDir+ , Cradle(..) ) import Language.Haskell.GhcImportedFrom.UtilsFromGhcMod import Language.Haskell.GhcImportedFrom.Types ++#if __GLASGOW_HASKELL__ >= 708+import DynFlags ( unsafeGlobalDynFlags )+tdflags = unsafeGlobalDynFlags+#else+import DynFlags ( tracingDynFlags )+tdflags = tracingDynFlags+#endif++type GHCOption = String++getGhcOptionsViaCabalRepl :: IO (Maybe [String])+getGhcOptionsViaCabalRepl = do+ (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++ result <- if ineof+ then return ""+ else do firstLine <- hGetLine hout+ if "GHCi" `isPrefixOf` firstLine+ then return "DERP" -- stuffed up, should report error+ else do rest <- readRestOfHandle hout+ return $ firstLine ++ "\n" ++ rest++ let result' = filter ("--interactive" `isPrefixOf`) . lines $ result++ 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++ dropModuleNames :: [String] -> [String]+ dropModuleNames xs = reverse $ dropWhile (not . ("-" `isPrefixOf`)) (reverse xs)++getGhcOptionsViaCabalReplOrEmpty :: IO [String]+getGhcOptionsViaCabalReplOrEmpty = liftM (fromMaybe []) getGhcOptionsViaCabalRepl+ type QualifiedName = String -- ^ A qualified name, e.g. @Foo.bar@. type Symbol = String -- ^ A symbol, possibly qualified, e.g. @bar@ or @Foo.bar@.@@ -130,66 +158,20 @@ , modSpecifically :: [String] } deriving (Show, Eq) --- | Convert a GHC command line option to a @ghc-pkg@ command line option. This function--- is incomplete; it only handles a few cases at the moment.-ghcOptionToGhcPKg :: [String] -> [String]-ghcOptionToGhcPKg [] = []-ghcOptionToGhcPKg (x:xs) = case x of "-no-user-package-db" -> "--no-user-package-db":ghcOptionToGhcPKg xs- "-package-db" -> ["--package-db", head xs] ++ ghcOptionToGhcPKg (tail xs)- _ -> error $ "Unknown GHC option: " ++ show (x:xs) -- FIXME Other cases?---- | Use ghcmod's API to get the GHC options for a project. This uses 'findCradle', 'cradlePackageDbOpts', and 'GhcOptions'.-getGhcOptionsViaGhcMod :: IO GhcOptions-getGhcOptionsViaGhcMod = GhcOptions . cradlePackageDbOpts <$> findCradle---- | Use ghcmod's API to get the GHC options for a project. This uses 'findCradle' and 'getGHCOptions.'-getGHCOptionsViaCradle :: IO [GHCOption]-getGHCOptionsViaCradle = do- c <- findCradle- pkgDesc <- GhcMonad.liftIO $ parseCabalFile $ fromJust $ cradleCabalFile c- 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.+-- | Add user-supplied GHC options to those discovered via cabl repl. modifyDFlags :: [String] -> DynFlags -> IO ([String], [GHCOption], DynFlags) modifyDFlags ghcOpts0 dflags0 = defaultErrorHandler defaultFatalMessager defaultFlushOut $ runGhc (Just libdir) $ do- (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+ ghcOpts1 <- GhcMonad.liftIO getGhcOptionsViaCabalReplOrEmpty - -- 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)+ (dflags1, _, _) <- GHC.parseDynamicFlags dflags0 (map SrcLoc.noLoc $ ghcOpts0 ++ ghcOpts1) let dflags2 = dflags1 { hscTarget = HscInterpreted , ghcLink = LinkInMemory- , importPaths = iPaths } - dflags3 = addDevPkgs dflags2 coDepPkgs-- return (ghcOpts1, ghcOpts2, dflags3)+ return ([], [], dflags2) -- | Set GHC options and run 'initPackages' in 'GhcMonad'. --@@ -204,6 +186,7 @@ (ghcOpts1, ghcOpts2, dflags1) <- GhcMonad.liftIO $ modifyDFlags extraGHCOpts dflags0 void $ setSessionDynFlags dflags1 _ <- GhcMonad.liftIO $ Packages.initPackages dflags1+ return (ghcOpts1, ghcOpts2, dflags1) -- |Read the textual imports in a file.@@ -294,11 +277,11 @@ toHaskellModule :: SrcLoc.Located (GHC.ImportDecl GHC.RdrName) -> HaskellModule toHaskellModule idecl = HaskellModule name qualifier isImplicit hiding importedAs specifically where idecl' = SrcLoc.unLoc idecl- name = showSDoc tracingDynFlags (ppr $ GHC.ideclName idecl')+ name = showSDoc tdflags (ppr $ GHC.ideclName idecl') isImplicit = GHC.ideclImplicit idecl' qualifier = unpackFS <$> GHC.ideclPkgQual idecl' hiding = map removeBrackets $ (catMaybes . parseHiding . GHC.ideclHiding) idecl'- importedAs = (showSDoc tracingDynFlags . ppr) <$> ideclAs idecl'+ importedAs = (showSDoc tdflags . ppr) <$> ideclAs idecl' specifically = map removeBrackets $ (parseSpecifically . GHC.ideclHiding) idecl' removeBrackets :: [a] -> [a]@@ -306,7 +289,7 @@ removeBrackets x = (init . tail) x grabNames :: GHC.Located (GHC.IE GHC.RdrName) -> String- grabNames loc = showSDoc tracingDynFlags (ppr names)+ grabNames loc = showSDoc tdflags (ppr names) where names = GHC.ieNames $ SrcLoc.unLoc loc parseHiding :: Maybe (Bool, [Located (IE RdrName)]) -> [Maybe String]@@ -334,7 +317,7 @@ -- Example: -- -- >>> x <- lookupSymbol "tests/data/data/Hiding.hs" "Hiding" "head" ["Prelude", "Safe", "System.Environment", "Data.List"]--- *GhcImportedFrom> putStrLn . (showSDoc tracingDynFlags) . ppr $ x+-- *GhcImportedFrom> putStrLn . (showSDoc tdflags) . ppr $ x -- [(GHC.List.head, -- [GHC.List.head -- imported from `Data.List' at tests/data/data/Hiding.hs:5:1-29@@ -448,7 +431,7 @@ es = listifySpans tcs (lineNr, colNr) :: [LHsExpr Id] ps = listifySpans tcs (lineNr, colNr) :: [LPat Id] - let foo x = showSDoc tracingDynFlags $ ppr x+ let foo x = showSDoc tdflags $ ppr x bs' = map foo bs es' = map foo es ps' = map foo ps@@ -464,14 +447,21 @@ then return "" else hGetContents h +optsForGhcPkg :: [String] -> [String]+optsForGhcPkg [] = []+optsForGhcPkg ("-no-user-package-db":rest) = "--no-user-package-db" : optsForGhcPkg rest+optsForGhcPkg ("-package-db":pd:rest) = ("--package-db" ++ "=" ++ pd) : optsForGhcPkg rest+optsForGhcPkg ("-package-conf":pc:rest) = ("--package-conf" ++ "=" ++ pc) : optsForGhcPkg rest+optsForGhcPkg ("-no-user-package-conf":rest) = "--no-user-package-conf" : optsForGhcPkg rest+optsForGhcPkg (_:rest) = optsForGhcPkg rest+ -- | 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 -> WriterT [String] IO (Maybe String) ghcPkgFindModule (GhcPkgOptions extraGHCPkgOpts) m = do-- (GhcOptions gopts) <- CMT.liftIO getGhcOptionsViaGhcMod :: WriterT [String] IO GhcOptions+ gopts <- CMT.liftIO getGhcOptionsViaCabalReplOrEmpty - let opts = ["find-module", m, "--simple-output"] ++ ["--global", "--user"] ++ ghcOptionToGhcPKg gopts ++ extraGHCPkgOpts+ let opts = ["find-module", m, "--simple-output"] ++ ["--global", "--user"] ++ optsForGhcPkg gopts ++ extraGHCPkgOpts myTell $ "ghc-pkg " ++ show opts (_, Just hout, Just herr, _) <- CMT.liftIO $ createProcess (proc "ghc-pkg" opts){ std_in = CreatePipe@@ -481,17 +471,18 @@ output <- CMT.liftIO $ readRestOfHandle hout err <- CMT.liftIO $ readRestOfHandle herr- myTell $ "ghcPkgFindModule stdout: " ++ output- myTell $ "ghcPkgFindModule stderr: " ++ err + myTell $ "ghcPkgFindModule stdout: " ++ show output+ myTell $ "ghcPkgFindModule stderr: " ++ show err+ 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 -> WriterT [String] IO (Maybe String) ghcPkgHaddockUrl (GhcPkgOptions extraGHCPkgOpts) p = do- (GhcOptions gopts) <- CMT.liftIO getGhcOptionsViaGhcMod :: WriterT [String] IO GhcOptions+ gopts <- CMT.liftIO getGhcOptionsViaCabalReplOrEmpty - let opts = ["field", p, "haddock-html"] ++ ["--global", "--user"] ++ ghcOptionToGhcPKg gopts ++ extraGHCPkgOpts+ let opts = ["field", p, "haddock-html"] ++ ["--global", "--user"] ++ optsForGhcPkg gopts ++ extraGHCPkgOpts myTell $ "ghc-pkg "++ show opts (_, Just hout, _, _) <- CMT.liftIO $ createProcess (proc "ghc-pkg" opts){ std_in = CreatePipe@@ -583,23 +574,23 @@ -- Adapted from http://www.haskell.org/pipermail/haskell-cafe/2010-June/078702.html substringP :: String -> String -> Maybe Int substringP _ [] = Nothing- substringP sub str = if sub `isPrefixOf` str then Just 0 else fmap (+1) $ substringP sub (tail str)+ substringP sub str = if sub `isPrefixOf` str then Just 0 else (+1) <$> substringP sub (tail str) -- | 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''- where name' = showSDoc tracingDynFlags $ ppr name+ where name' = showSDoc tdflags $ ppr name name'' = fromJust $ moduleOfQualifiedName name' -- FIXME dangerous fromJust x = concatMap symbolImportedFrom lookUp- x' = map (showSDoc tracingDynFlags . ppr) x+ 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] -> GhcPkgOptions -> (Name, [GlobalRdrElt]) -> WriterT [String] IO (Maybe String, Maybe String, Maybe String, Maybe String) findHaddockModule symbol'' smatches ghcPkgOpts (name, lookUp) = do- myTell $ "name: " ++ showSDoc tracingDynFlags (ppr name)+ myTell $ "name: " ++ showSDoc tdflags (ppr name) let definedIn = nameModule name bpms = bestPrefixMatches name lookUp@@ -608,13 +599,13 @@ -- 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 tracingDynFlags . ppr) $ concatMap symbolImportedFrom lookUp+ then if null bpms then Safe.headMay $ map (showSDoc tdflags . ppr) $ concatMap symbolImportedFrom lookUp else Safe.headMay bpms :: Maybe String- else (Just . (showSDoc tracingDynFlags . ppr) . mkModuleName . fromJust . moduleOfQualifiedName) symbol'' -- FIXME dangerous fromJust+ else (Just . (showSDoc tdflags . ppr) . mkModuleName . fromJust . moduleOfQualifiedName) symbol'' -- FIXME dangerous fromJust - myTell $ "definedIn: " ++ showSDoc tracingDynFlags (ppr definedIn)+ myTell $ "definedIn: " ++ showSDoc tdflags (ppr definedIn) myTell $ "bpms: " ++ show bpms- myTell $ "concat $ map symbolImportedFrom lookUp: " ++ showSDoc tracingDynFlags (ppr $ concatMap symbolImportedFrom lookUp)+ myTell $ "concat $ map symbolImportedFrom lookUp: " ++ showSDoc tdflags (ppr $ concatMap symbolImportedFrom lookUp) myTell $ "importedFrom: " ++ show importedFrom@@ -652,7 +643,7 @@ if e then return $ "file://" ++ f else do myTell $ "f: " ++ show f myTell $ "foundModule: " ++ show foundModule'- return $ toHackageUrl f foundModule' (showSDoc tracingDynFlags (ppr importedFrom'))+ return $ toHackageUrl f foundModule' (showSDoc tdflags (ppr importedFrom')) -- | Attempt to guess the Haddock url, either a local file path or url to @hackage.haskell.org@@@ -665,7 +656,14 @@ -- 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 -> WriterT [String] IO (Either String String)-guessHaddockUrl targetFile targetModule symbol lineNr colNr (GhcOptions ghcOpts0) ghcPkgOpts = do+guessHaddockUrl _targetFile targetModule symbol lineNr colNr (GhcOptions ghcOpts0) ghcPkgOpts = do+ c <- CMT.liftIO findCradle+ let currentDir = cradleCurrentDir c+ workDir = cradleRootDir c+ CMT.liftIO $ setCurrentDirectory workDir++ let targetFile = currentDir </> _targetFile+ myTell $ "targetFile: " ++ targetFile myTell $ "targetModule: " ++ targetModule myTell $ "symbol: " ++ show symbol
− Language/Haskell/GhcImportedFrom/UtilsFromCabalInstall.hs
@@ -1,46 +0,0 @@--------------------------------------------------------------------------------- |--- Module : UtilsFromCabalInstall--- Copyright : Carlo Hamalainen 2014--- License : BSD3------ Maintainer : carlo@carlo-hamalainen.net--- Stability : experimental--- Portability : portable------ We need a function from cabal-install which is not exported.--module Language.Haskell.GhcImportedFrom.UtilsFromCabalInstall where--import Data.Word ( Word32 )-import Numeric ( showHex )-import Data.List ( foldl' )-import Data.Char ( ord )-import Data.Bits ( shiftL, shiftR, xor )---- Required for a temporary workaround for https://github.com/carlohamalainen/ghc-imported-from/issues/10---- https://github.com/haskell/cabal/blob/master/cabal-install/Distribution/Client/Sandbox.hs#L129-sandboxBuildDir :: FilePath -> FilePath-sandboxBuildDir sandboxDir = "dist/dist-sandbox-" ++ showHex sandboxDirHash ""- where- sandboxDirHash = jenkins sandboxDir-- -- See http://en.wikipedia.org/wiki/Jenkins_hash_function- jenkins :: String -> Word32- jenkins str = loop_finish $ foldl' loop 0 str- where- loop :: Word32 -> Char -> Word32- loop hash key_i' = hash'''- where- key_i = toEnum . ord $ key_i'- hash' = hash + key_i- hash'' = hash' + (shiftL hash' 10)- hash''' = hash'' `xor` (shiftR hash'' 6)-- loop_finish :: Word32 -> Word32- loop_finish hash = hash'''- where- hash' = hash + (shiftL hash 3)- hash'' = hash' `xor` (shiftR hash' 11)- hash''' = hash'' + (shiftL hash'' 15)
Language/Haskell/GhcImportedFrom/UtilsFromGhcMod.hs view
@@ -25,32 +25,10 @@ module Language.Haskell.GhcImportedFrom.UtilsFromGhcMod where -import Language.Haskell.GhcImportedFrom.UtilsFromCabalInstall--import Control.Applicative import Data.Generics hiding (typeOf) import GHC import GHC.SYB.Utils-import System.Directory-import System.FilePath -import Packages--import Language.Haskell.GhcMod-import Language.Haskell.GhcMod.Internal-import Distribution.PackageDescription-import Distribution.Simple.Compiler (CompilerId(..), CompilerFlavor(..))-import Distribution.Simple.Program (ghcProgram)-import Distribution.Simple.Program.Types (programName, programFindVersion)-import Distribution.Text as DistText-import Distribution.Verbosity (silent)--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@@ -60,114 +38,3 @@ -- ghcmod/Language/Haskell/GhcMod/Info.hs listifyStaged :: Typeable r => Stage -> (r -> Bool) -> GenericQ [r] listifyStaged s p = everythingStaged s (++) [] ([] `mkQ` (\x -> [x | p x]))---- ghc-mod/Language/Haskell/GhcMod/CabalApi.hs-getGHCOptions :: [GHCOption] -> Cradle -> String -> BuildInfo -> IO [GHCOption]-getGHCOptions ghcopts cradle cdir binfo = do- cabalCpp <- cabalCppOptions cdir- let cpps = map ("-optP" ++) $ cppOptions binfo ++ cabalCpp-- return $ ghcopts ++ pkgDb ++ exts ++ [lang] ++ libs ++ libDirs ++ cpps- where- pkgDb = cradlePackageDbOpts cradle- lang = maybe "-XHaskell98" (("-X" ++) . DistText.display) $ defaultLanguage binfo- libDirs = map ("-L" ++) $ extraLibDirs binfo- exts = map (("-X" ++) . DistText.display) $ usedExtensions binfo- libs = map ("-l" ++) $ extraLibs binfo---- ghc-mod/Language/Haskell/GhcMod/CabalApi.hs--- modification: return $ if ... instead of if .. return--- Extra modification: add dist-sandbox-[hash] directory.-cabalCppOptions :: FilePath -> IO [String]-cabalCppOptions dir = do- let sandboxSubDir = sandboxBuildDir $ dir </> ".cabal-sandbox"- sandboxFullPath = dir </> sandboxSubDir-- opts1 <- makeOpt $ dir </> "dist/build/autogen/cabal_macros.h"- opts2 <- makeOpt $ sandboxFullPath </> "build/autogen/cabal_macros.h"-- return $ opts1 ++ opts2- where- makeOpt :: FilePath -> IO [String]- makeOpt cabalMacroDotH = do- exist <- doesFileExist cabalMacroDotH- return $ if exist then ["-include", cabalMacroDotH]- else []---- ghc-mod/Language/Haskell/GhcMod/CabalApi.hs-getGHCId :: IO CompilerId-getGHCId = CompilerId GHC <$> getGHC---- ghc-mod/Language/Haskell/GhcMod/CabalApi.hs-getGHC :: IO Version-getGHC = do- mv <- programFindVersion ghcProgram silent (programName ghcProgram)- 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- sandboxSubDir = sandboxBuildDir $ wdir </> ".cabal-sandbox"- sandboxFullPath = wdir </> sandboxSubDir-- extdirs = map expand $ dirs ++ cabalBuildDirs ++ [sandboxFullPath </> "build", sandboxFullPath </> "build/autogen"]:: [FilePath]-- expand :: FilePath -> FilePath- 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- }--
ghc-imported-from.cabal view
@@ -1,5 +1,5 @@ name: ghc-imported-from-version: 0.1.0.4+version: 0.2.0.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.@@ -20,21 +20,20 @@ library exposed-modules: Language.Haskell.GhcImportedFrom other-modules: Language.Haskell.GhcImportedFrom.UtilsFromGhcMod- Language.Haskell.GhcImportedFrom.UtilsFromCabalInstall Language.Haskell.GhcImportedFrom.Types other-extensions: CPP, Rank2Types- build-depends: base >=4.6 && <4.7- , syb >=0.4 && <0.5- , ghc >=7.6 && <7.7- , ghc-paths >=0.1 && <0.2+ build-depends: base >=4.6 && <4.8+ , syb+ , ghc+ , ghc-paths , ghc-syb-utils- , ghc-mod >= 3.1.5 && <= 3.1.5+ , ghc-mod , filepath , safe , process , directory- , containers >= 0.5.0.0 && <= 0.5.0.0+ , containers , mtl , transformers if impl(ghc < 7.7)@@ -44,23 +43,31 @@ default-language: Haskell2010 +executable fake-ghc-for-ghc-imported-from+ main-is: fake-ghc-for-ghc-imported-from.hs+ GHC-Options: -Wall+ hs-source-dirs: src+ build-depends: base >=4.6 && <4.8+ , process+ default-language: Haskell2010+ executable ghc-imported-from main-is: Main.hs GHC-Options: -Wall other-modules: Paths_ghc_imported_from other-extensions: CPP, Rank2Types- build-depends: base >=4.6 && <4.7- , syb >=0.4 && <0.5- , ghc >=7.6 && <7.7- , ghc-paths >=0.1 && <0.2+ build-depends: base >=4.6 && <4.8+ , syb+ , ghc+ , ghc-paths , ghc-syb-utils- , ghc-mod >= 3.1.5+ , ghc-mod , ghc-imported-from , filepath , safe , process , directory- , containers >= 0.5.0.0 && <= 0.5.0.0+ , containers , mtl , transformers , hspec@@ -81,17 +88,17 @@ Type: exitcode-stdio-1.0 Other-Modules: Dir ImportedFromSpec- Build-Depends: base >=4.6 && <4.7- , syb >=0.4 && <0.5- , ghc >=7.6 && <7.7- , ghc-paths >=0.1 && <0.2+ Build-Depends: base >=4.6 && <4.8+ , syb+ , ghc+ , ghc-paths , ghc-syb-utils- , ghc-mod >= 3.1.5+ , ghc-mod , filepath , safe , process , directory- , containers >= 0.5.0.0 && <= 0.5.0.0+ , containers , mtl , transformers , hspec@@ -99,4 +106,3 @@ Build-Depends: Cabal >= 1.10 && < 1.17 else Build-Depends: Cabal >= 1.18-
+ src/fake-ghc-for-ghc-imported-from.hs view
@@ -0,0 +1,25 @@+module Main where++-- Fake ghc binary, used to extract the GHC command line options+-- via the "cabal repl" command. Thanks to Herbert Valerio Riedel+-- on haskell-cafe for the tip:+--+-- http://www.haskell.org/pipermail/haskell-cafe/2014-May/114183.html++-- If we are called with --numeric-version or --info then we lie and pretend+-- to be the system's current default ghc binary. Will this cause problems if+-- someone is using --with-ghc elsewhere to choose the ghc binary?++import Data.List (unwords)+import System.Cmd (rawSystem)+import System.Environment (getArgs)++main :: IO ()+main = do+ args <- getArgs++ if length args == 1+ then case head args of "--numeric-version" -> rawSystem "ghc" ["--numeric-version"] >> return ()+ "--info" -> rawSystem "ghc" ["--info"] >> return ()+ _ -> putStrLn $ unwords args+ else putStrLn $ unwords args