ghc-mod 1.11.5 → 1.12.0
raw patch · 23 files changed
+513/−284 lines, 23 filesdep −regex-posix
Dependencies removed: regex-posix
Files
- Browse.hs +9/−4
- Cabal.hs +0/−79
- CabalApi.hs +141/−32
- CabalDev.hs +0/−52
- ChangeLog +7/−1
- Check.hs +6/−7
- Cradle.hs +73/−0
- Debug.hs +37/−0
- ErrMsg.hs +3/−2
- GHCApi.hs +115/−35
- GHCMod.hs +34/−11
- Info.hs +17/−18
- List.hs +2/−2
- Types.hs +17/−0
- elisp/ghc-flymake.el +18/−1
- ghc-mod.cabal +4/−6
- test/BrowseSpec.hs +4/−0
- test/CabalApiSpec.hs +4/−3
- test/CabalSpec.hs +0/−23
- test/CheckSpec.hs +7/−3
- test/Expectation.hs +7/−2
- test/InfoSpec.hs +7/−3
- test/data/cabal-dev/packages-7.6.2.conf +1/−0
Browse.hs view
@@ -13,6 +13,7 @@ import Type import Types import Var+import DataCon (dataConRepType) ---------------------------------------------------------------- @@ -32,8 +33,8 @@ formatOps' [] = error "formatOps'" browse :: Options -> String -> IO [String]-browse opt mdlName = withGHC $ do- _ <- initSession0 opt+browse opt mdlName = withGHCDummyFile $ do+ initializeFlags opt getModule >>= getModuleInfo >>= listExports where getModule = findModule (mkModuleName mdlName) Nothing@@ -59,11 +60,15 @@ inOtherModule nm = getModuleInfo (nameModule nm) >> lookupGlobalName nm showThing :: TyThing -> Maybe String-showThing (AnId i) = Just $ getOccString i ++ " :: " ++ showOutputable (removeForAlls $ varType i)-showThing (ATyCon t) = unwords . toList <$> tyType t+showThing (AnId i) = Just $ formatType varType i+showThing (ADataCon d) = Just $ formatType dataConRepType d+showThing (ATyCon t) = unwords . toList <$> tyType t where toList t' = t' : getOccString t : map getOccString (tyConTyVars t) showThing _ = Nothing++formatType :: NamedThing a => (a -> Type) -> a -> String+formatType f x = getOccString x ++ " :: " ++ showOutputable (removeForAlls $ f x) tyType :: TyCon -> Maybe String tyType typ
− Cabal.hs
@@ -1,79 +0,0 @@-{-# LANGUAGE OverloadedStrings, RecordWildCards #-}--module Cabal (initializeGHC, getDirs, fromCabal) where--import CabalApi (cabalParseFile, cabalBuildInfo, cabalDependPackages)-import Control.Applicative-import Control.Exception-import Control.Monad-import CoreMonad-import Data.List-import Distribution.PackageDescription (BuildInfo(..), usedExtensions)-import Distribution.Text (display)-import ErrMsg-import GHC-import GHCApi-import GHCChoice-import System.Directory-import System.FilePath-import Types--------------------------------------------------------------------importDirs :: [String]-importDirs = [".","..","../..","../../..","../../../..","../../../../.."]--initializeGHC :: Options -> FilePath -> [String] -> Bool -> Ghc (FilePath,LogReader)-initializeGHC opt fileName ghcOptions logging = withCabal ||> withoutCabal- where- withoutCabal = do- logReader <- initSession opt ghcOptions importDirs Nothing logging- return (fileName,logReader)- withCabal = do- (gopts,idirs,depPkgs) <- liftIO $ fromCabal ghcOptions- logReader <- initSession opt gopts idirs (Just depPkgs) logging- return (fileName,logReader)--fromCabal :: [String] -> IO ([String], [FilePath], [String])-fromCabal ghcOptions = do- (owdir,cdir,cfile) <- getDirs- cabal <- cabalParseFile cfile- binfo@BuildInfo{..} <- cabalBuildInfo cabal- let exts = map (("-X" ++) . display) $ usedExtensions binfo- lang = maybe "-XHaskell98" (("-X" ++) . display) defaultLanguage- libs = map ("-l" ++) extraLibs- libDirs = map ("-L" ++) extraLibDirs- gopts = ghcOptions ++ exts ++ [lang] ++ libs ++ libDirs- idirs = case hsSourceDirs of- [] -> [cdir,owdir]- dirs -> map (cdir </>) dirs ++ [owdir]- depPkgs <- removeMe cfile <$> cabalDependPackages cabal- return (gopts,idirs,depPkgs)--removeMe :: FilePath -> [String] -> [String]-removeMe cabalfile depPkgs = filter (/= me) depPkgs- where- me = dropExtension $ takeFileName cabalfile---------------------------------------------------------------------- CurrentWorkingDir, CabalDir, CabalFile-getDirs :: IO (FilePath,FilePath,FilePath)-getDirs = do- wdir <- getCurrentDirectory- (cdir,cfile) <- cabalDir wdir- return (wdir,cdir,cfile)---- Causes error, catched in the upper function.--- CabalDir, CabalFile-cabalDir :: FilePath -> IO (FilePath,FilePath)-cabalDir dir = do- cnts <- (filter isCabal <$> getDirectoryContents dir)- >>= filterM (\file -> doesFileExist (dir </> file))- let dir' = takeDirectory dir- case cnts of- [] | dir' == dir -> throwIO $ userError "No cabal file"- | otherwise -> cabalDir dir'- cfile:_ -> return (dir,dir </> cfile)- where- isCabal name = ".cabal" `isSuffixOf` name && length name > 6
CabalApi.hs view
@@ -1,55 +1,164 @@+{-# LANGUAGE OverloadedStrings #-}+ module CabalApi (- cabalParseFile,- cabalBuildInfo,- cabalDependPackages+ fromCabalFile+ , cabalParseFile+ , cabalBuildInfo+ , cabalAllDependPackages+ , cabalAllExtentions+ , getGHCVersion ) where import Control.Applicative--import Data.Maybe (fromJust, maybeToList)+import Control.Exception (throwIO)+import Data.List (intercalate)+import Data.Maybe (fromJust, maybeToList, mapMaybe) import Data.Set (fromList, toList)--import Distribution.Verbosity (silent) import Distribution.Package (Dependency(Dependency), PackageName(PackageName)) import Distribution.PackageDescription- (GenericPackageDescription,- condLibrary, condExecutables, condTestSuites, condBenchmarks,- BuildInfo, libBuildInfo, buildInfo,- CondTree, condTreeConstraints, condTreeData) import Distribution.PackageDescription.Parse (readPackageDescription)+import Distribution.Simple.Program (ghcProgram)+import Distribution.Simple.Program.Types (programName, programFindVersion)+import Distribution.Text (display)+import Distribution.Verbosity (silent)+import Distribution.Version (versionBranch)+import Language.Haskell.Extension (Extension(..))+import System.FilePath+import Types ---------------------------------------------------------------- +fromCabalFile :: [GHCOption]+ -> Cradle+ -> IO ([GHCOption],[IncludeDir],[Package],[LangExt])+fromCabalFile ghcOptions cradle =+ cookInfo ghcOptions cradle <$> cabalParseFile cfile+ where+ Just cfile = cradleCabalFile cradle++cookInfo :: [String] -> Cradle -> GenericPackageDescription+ -> ([GHCOption],[IncludeDir],[Package],[LangExt])+cookInfo ghcOptions cradle cabal = (gopts,idirs,depPkgs,hdrExts)+ where+ owdir = cradleCurrentDir cradle+ Just cdir = cradleCabalDir cradle+ Just cfile = cradleCabalFile cradle+ binfo = cabalBuildInfo cabal+ gopts = getGHCOptions ghcOptions binfo+ idirs = includeDirectroies cdir owdir $ hsSourceDirs binfo+ depPkgs = removeMe cfile $ cabalAllDependPackages cabal+ hdrExts = cabalAllExtentions cabal++removeMe :: FilePath -> [String] -> [String]+removeMe cabalfile = filter (/= me)+ where+ me = dropExtension $ takeFileName cabalfile++----------------------------------------------------------------+ cabalParseFile :: FilePath -> IO GenericPackageDescription-cabalParseFile = readPackageDescription silent+cabalParseFile = readPackageDescription silent +----------------------------------------------------------------++getGHCOptions :: [String] -> BuildInfo -> [String]+getGHCOptions ghcOptions binfo = ghcOptions ++ exts ++ [lang] ++ libs ++ libDirs+ where+ exts = map (("-X" ++) . display) $ usedExtensions binfo+ lang = maybe "-XHaskell98" (("-X" ++) . display) $ defaultLanguage binfo+ libs = map ("-l" ++) $ extraLibs binfo+ libDirs = map ("-L" ++) $ extraLibDirs binfo++----------------------------------------------------------------+ -- Causes error, catched in the upper function.-cabalBuildInfo :: GenericPackageDescription -> IO BuildInfo-cabalBuildInfo pd =- return . fromJust $ fromLibrary pd <|> fromExecutable pd+cabalBuildInfo :: GenericPackageDescription -> BuildInfo+cabalBuildInfo pd = fromJust $ fromLibrary pd <|> fromExecutable pd where fromLibrary c = libBuildInfo . condTreeData <$> condLibrary c fromExecutable c = buildInfo . condTreeData . snd <$> toMaybe (condExecutables c)- toMaybe [] = Nothing+ toMaybe [] = Nothing toMaybe (x:_) = Just x -getDepsOfPairs :: [(a1, CondTree v [b] a)] -> [b]-getDepsOfPairs = concatMap (condTreeConstraints . snd)+---------------------------------------------------------------- -allDependsOfDescription :: GenericPackageDescription -> [Dependency]-allDependsOfDescription pd =- concat [depLib, depExe, depTests, depBench]+cabalAllDependPackages :: GenericPackageDescription -> [Package]+cabalAllDependPackages pd = uniqueAndSort pkgs where- depLib = concatMap condTreeConstraints (maybeToList . condLibrary $ pd)- depExe = getDepsOfPairs . condExecutables $ pd- depTests = getDepsOfPairs . condTestSuites $ pd- depBench = getDepsOfPairs . condBenchmarks $ pd+ pkgs = map getDependencyPackageName $ cabalAllDependency pd -getDependencyPackageName :: Dependency -> String-getDependencyPackageName (Dependency (PackageName n) _) = n+cabalAllDependency :: GenericPackageDescription -> [Dependency]+cabalAllDependency = fromPackageDescription getDeps getDeps getDeps getDeps+ where+ getDeps :: [Tree a] -> [Dependency]+ getDeps = concatMap condTreeConstraints -cabalDependPackages :: GenericPackageDescription -> IO [String]-cabalDependPackages =- return . toList . fromList- . map getDependencyPackageName- . allDependsOfDescription+getDependencyPackageName :: Dependency -> Package+getDependencyPackageName (Dependency (PackageName nm) _) = nm++----------------------------------------------------------------++cabalAllExtentions :: GenericPackageDescription -> [LangExt]+cabalAllExtentions pd = uniqueAndSort exts+ where+ buildInfos = cabalAllBuildInfos pd+ eexts = concatMap oldExtensions buildInfos+ ++ concatMap defaultExtensions buildInfos+ exts = mapMaybe getExtensionName eexts++getExtensionName :: Extension -> Maybe LangExt+getExtensionName (EnableExtension nm) = Just (display nm)+getExtensionName _ = Nothing++----------------------------------------------------------------++cabalAllBuildInfos :: GenericPackageDescription -> [BuildInfo]+cabalAllBuildInfos = fromPackageDescription f1 f2 f3 f4+ where+ f1 = map (libBuildInfo . condTreeData)+ f2 = map (buildInfo . condTreeData)+ f3 = map (testBuildInfo . condTreeData)+ f4 = map (benchmarkBuildInfo . condTreeData)++----------------------------------------------------------------++type Tree = CondTree ConfVar [Dependency]++fromPackageDescription :: ([Tree Library] -> [a])+ -> ([Tree Executable] -> [a])+ -> ([Tree TestSuite] -> [a])+ -> ([Tree Benchmark] -> [a])+ -> GenericPackageDescription+ -> [a]+fromPackageDescription f1 f2 f3 f4 pd = lib ++ exe ++ tests ++ bench+ where+ lib = f1 . maybeToList . condLibrary $ pd+ exe = f2 . map snd . condExecutables $ pd+ tests = f3 . map snd . condTestSuites $ pd+ bench = f4 . map snd . condBenchmarks $ pd++----------------------------------------------------------------++includeDirectroies :: String -> String -> [FilePath] -> [String]+includeDirectroies cdir owdir [] = uniqueAndSort [cdir,owdir]+includeDirectroies cdir owdir dirs = uniqueAndSort (map (cdir </>) dirs ++ [owdir])++----------------------------------------------------------------++uniqueAndSort :: [String] -> [String]+uniqueAndSort = toList . fromList++----------------------------------------------------------------++getGHCVersion :: IO (String, Int)+getGHCVersion = ghcVer >>= toTupple+ where+ ghcVer = programFindVersion ghcProgram silent (programName ghcProgram)+ toTupple Nothing = throwIO $ userError "ghc not found"+ toTupple (Just v)+ | length vs < 2 = return (verstr, 0)+ | otherwise = return (verstr, ver)+ where+ vs = versionBranch v+ ver = (vs !! 0) * 100 + (vs !! 1)+ verstr = intercalate "." . map show $ vs
− CabalDev.hs
@@ -1,52 +0,0 @@-module CabalDev (modifyOptions) where--{-- If the directory 'cabal-dev/packages-X.X.X.conf' exists, add it to the- options ghc-mod uses to check the source. Otherwise just pass it on.--}--import Control.Applicative ((<$>))-import Control.Exception (throwIO)-import Control.Exception.IOChoice-import Data.List (find)-import System.Directory-import System.FilePath (splitPath,joinPath,(</>))-import Text.Regex.Posix ((=~))-import Types--modifyOptions :: Options -> IO Options-modifyOptions opts = found ||> notFound- where- found = addPath opts <$> findCabalDev (sandbox opts)- notFound = return opts--findCabalDev :: Maybe String -> IO FilePath-findCabalDev Nothing = getCurrentDirectory >>= searchIt . splitPath-findCabalDev (Just path) = do- exist <- doesDirectoryExist path- if exist then- findConf path- else- findCabalDev Nothing--addPath :: Options -> String -> Options-addPath orig_opts path = orig_opts { ghcOpts = opts' }- where- orig_ghcopt = ghcOpts orig_opts- opts' = orig_ghcopt ++ ["-package-conf", path, "-no-user-package-conf"]--searchIt :: [FilePath] -> IO FilePath-searchIt [] = throwIO $ userError "Not found"-searchIt path = do- exist <- doesDirectoryExist cabalDir- if exist then- findConf cabalDir- else- searchIt $ init path- where- cabalDir = joinPath path </> "cabal-dev/"--findConf :: FilePath -> IO FilePath-findConf path = do- Just f <- find (=~ "packages.*\\.conf") <$> getDirectoryContents path- return $ path </> f
ChangeLog view
@@ -1,6 +1,12 @@+2013-03-05 v1.12.0++ * "ghc-mod debug" to see which cabal file and sand box are used+ * Fast "ghc-mod check" if Template Haskell is not used+ * "ghc-mod brwose -d" displays more information (@eagletmt)+ 2013-03-01 v1.11.5 - * New option "-d" for "ghc-mod brouse" to show symbols with type+ * New option "-d" for "ghc-mod browse" to show symbols with type info (@moidex) 2013-02-15 v1.11.4
Check.hs view
@@ -1,6 +1,5 @@ module Check (checkSyntax) where -import Cabal import Control.Applicative import CoreMonad import ErrMsg@@ -12,17 +11,17 @@ ---------------------------------------------------------------- -checkSyntax :: Options -> String -> IO String-checkSyntax opt file = unlines <$> check opt file+checkSyntax :: Options -> Cradle -> String -> IO String+checkSyntax opt cradle file = unlines <$> check opt cradle file ---------------------------------------------------------------- -check :: Options -> String -> IO [String]-check opt fileName = withGHC' fileName $ checkIt `gcatch` handleErrMsg+check :: Options -> Cradle -> String -> IO [String]+check opt cradle fileName = withGHC fileName $ checkIt `gcatch` handleErrMsg where checkIt = do- (file,readLog) <- initializeGHC opt fileName options True- setTargetFile file+ readLog <- initializeFlagsWithCradle opt cradle fileName options True+ setTargetFile fileName _ <- load LoadAllTargets liftIO readLog options
+ Cradle.hs view
@@ -0,0 +1,73 @@+module Cradle (findCradle) where++import Control.Applicative ((<$>))+import Control.Exception (throwIO)+import Control.Monad+import Data.List (isSuffixOf)+import System.Directory+import System.FilePath ((</>),takeDirectory)+import Types++-- An error would be thrown+findCradle :: Maybe FilePath -> String -> IO Cradle+findCradle (Just sbox) strver = do+ pkgConf <- checkPackageConf sbox strver+ wdir <- getCurrentDirectory+ cfiles <- cabalDir wdir+ return $ case cfiles of+ Nothing -> Cradle {+ cradleCurrentDir = wdir+ , cradleCabalDir = Nothing+ , cradleCabalFile = Nothing+ , cradlePackageConf = Just pkgConf+ }+ Just (cdir,cfile) -> Cradle {+ cradleCurrentDir = wdir+ , cradleCabalDir = Just cdir+ , cradleCabalFile = Just cfile+ , cradlePackageConf = Just pkgConf+ }+findCradle Nothing strver = do+ wdir <- getCurrentDirectory+ cfiles <- cabalDir wdir+ case cfiles of+ Nothing -> return Cradle {+ cradleCurrentDir = wdir+ , cradleCabalDir = Nothing+ , cradleCabalFile = Nothing+ , cradlePackageConf = Nothing+ }+ Just (cdir,cfile) -> do+ let sbox = cdir </> "cabal-dev/"+ pkgConf = packageConfName sbox strver+ exist <- doesFileExist pkgConf+ return Cradle {+ cradleCurrentDir = wdir+ , cradleCabalDir = Just cdir+ , cradleCabalFile = Just cfile+ , cradlePackageConf = if exist then Just pkgConf else Nothing+ }++cabalDir :: FilePath -> IO (Maybe (FilePath,FilePath))+cabalDir dir = do+ cnts <- (filter isCabal <$> getDirectoryContents dir)+ >>= filterM (\file -> doesFileExist (dir </> file))+ let dir' = takeDirectory dir+ case cnts of+ [] | dir' == dir -> return Nothing+ | otherwise -> cabalDir dir'+ cfile:_ -> return $ Just (dir,dir </> cfile)+ where+ isCabal name = ".cabal" `isSuffixOf` name && length name > 6++packageConfName :: FilePath -> String -> FilePath+packageConfName path ver = path </> "packages-" ++ ver ++ ".conf"++checkPackageConf :: FilePath -> String -> IO FilePath+checkPackageConf path ver = do+ let conf = packageConfName path ver+ exist <- doesFileExist conf+ if exist then+ return conf+ else+ throwIO $ userError $ conf ++ " not found"
+ Debug.hs view
@@ -0,0 +1,37 @@+module Debug (debugInfo) where++import CabalApi+import GHCApi+import Control.Applicative+import Data.List (intercalate)+import Data.Maybe+import Prelude+import Types++----------------------------------------------------------------++debugInfo :: Options -> Cradle -> String -> String -> IO String+debugInfo opt cradle ver fileName = unlines <$> debug opt cradle ver fileName++debug :: Options -> Cradle -> String -> String -> IO [String]+debug opt cradle ver fileName = do+ (gopts, incDir, pkgs, langext) <-+ if cabal then+ fromCabalFile (ghcOpts opt) cradle+ else+ return (ghcOpts opt, [], [], [])+ dflags <- getDynamicFlags+ fast <- getFastCheck dflags fileName (Just langext)+ return [+ "GHC version: " ++ ver+ , "Current directory: " ++ currentDir+ , "Cabal file: " ++ cabalFile+ , "GHC options: " ++ unwords gopts+ , "Include directories: " ++ unwords incDir+ , "Dependent packages: " ++ intercalate ", " pkgs+ , "Fast check: " ++ if fast then "Yes" else "No"+ ]+ where+ currentDir = cradleCurrentDir cradle+ cabal = isJust $ cradleCabalFile cradle+ cabalFile = fromMaybe "" $ cradleCabalFile cradle
ErrMsg.hs view
@@ -14,6 +14,7 @@ import qualified Gap import HscTypes import Outputable+import System.FilePath (normalise) ---------------------------------------------------------------- @@ -52,10 +53,10 @@ ppMsg :: SrcSpan -> Severity-> SDoc -> PprStyle -> String ppMsg spn sev msg stl = fromMaybe def $ do (line,col,_,_) <- Gap.getSrcSpan spn- file <- Gap.getSrcFile spn+ file <- normalise <$> Gap.getSrcFile spn let severityCaption = Gap.showSeverityCaption sev return $ file ++ ":" ++ show line ++ ":"- ++ show col ++ ":" ++ severityCaption ++ cts ++ "\0"+ ++ show col ++ ":" ++ severityCaption ++ cts ++ "\0" where def = "ghc-mod:0:0:Probably mutual module import occurred\0" cts = showMsg msg stl
GHCApi.hs view
@@ -1,24 +1,36 @@-module GHCApi where+module GHCApi (+ withGHC+ , withGHCDummyFile+ , initializeFlags+ , initializeFlagsWithCradle+ , setTargetFile+ , getDynamicFlags+ , getFastCheck+ ) where +import CabalApi import Control.Applicative import Control.Exception+import Control.Monad import CoreMonad+import Data.Maybe (isJust) import DynFlags import ErrMsg import Exception import GHC import GHC.Paths (libdir)+import HeaderInfo import System.Exit import System.IO import Types ---------------------------------------------------------------- -withGHC :: Alternative m => Ghc (m a) -> IO (m a)-withGHC = withGHC' "Dummy"+withGHCDummyFile :: Alternative m => Ghc (m a) -> IO (m a)+withGHCDummyFile = withGHC "Dummy" -withGHC' :: Alternative m => FilePath -> Ghc (m a) -> IO (m a)-withGHC' file body = ghandle ignore $ runGhc (Just libdir) $ do+withGHC :: Alternative m => FilePath -> Ghc (m a) -> IO (m a)+withGHC file body = ghandle ignore $ runGhc (Just libdir) $ do dflags <- getSessionDynFlags defaultCleanupHandler dflags body where@@ -30,45 +42,108 @@ ---------------------------------------------------------------- -initSession0 :: Options -> Ghc [PackageId]-initSession0 opt = getSessionDynFlags >>=- (>>= setSessionDynFlags) . setGhcFlags opt+importDirs :: [IncludeDir]+importDirs = [".","..","../..","../../..","../../../..","../../../../.."] -initSession :: Options -> [String] -> [FilePath] -> Maybe [String] -> Bool -> Ghc LogReader-initSession opt cmdOpts idirs mayPkgs logging = do- dflags <- getSessionDynFlags- let opts = map noLoc cmdOpts- (dflags',_,_) <- parseDynamicFlags dflags opts- (dflags'',readLog) <- liftIO . (>>= setLogger logging)- . setGhcFlags opt . setFlags opt dflags' idirs $ mayPkgs- _ <- setSessionDynFlags dflags''+initializeFlagsWithCradle :: Options -> Cradle -> FilePath -> [GHCOption] -> Bool -> Ghc LogReader+initializeFlagsWithCradle opt cradle fileName ghcOptions logging+ | cabal = do+ (gopts,idirs,depPkgs,hdrExts) <- liftIO $ fromCabalFile ghcOptions cradle+ initSession opt gopts idirs (Just depPkgs) (Just hdrExts) logging fileName+ | otherwise =+ initSession opt ghcOptions importDirs Nothing Nothing logging fileName+ where+ cabal = isJust $ cradleCabalFile cradle++----------------------------------------------------------------++initSession :: Options+ -> [GHCOption]+ -> [IncludeDir]+ -> Maybe [Package]+ -> Maybe [LangExt]+ -> Bool+ -> FilePath+ -> Ghc LogReader+initSession opt cmdOpts idirs mDepPkgs mLangExts logging file = do+ dflags0 <- getSessionDynFlags+ (dflags1,readLog) <- setupDynamicFlags dflags0+ _ <- setSessionDynFlags dflags1 return readLog+ where+ setupDynamicFlags df0 = do+ df1 <- modifyFlagsWithOpts df0 cmdOpts+ fast <- liftIO $ getFastCheck df0 file mLangExts+ let df2 = modifyFlags df1 idirs mDepPkgs fast (expandSplice opt)+ df3 <- modifyFlagsWithOpts df2 $ ghcOpts opt+ liftIO $ setLogger logging df3 ---------------------------------------------------------------- -setFlags :: Options -> DynFlags -> [FilePath] -> Maybe [String] -> DynFlags-setFlags opt d idirs mayPkgs- | expandSplice opt = dopt_set d' Opt_D_dump_splices- | otherwise = d'+initializeFlags :: Options -> Ghc ()+initializeFlags opt = do+ dflags0 <- getSessionDynFlags+ dflags1 <- modifyFlagsWithOpts dflags0 $ ghcOpts opt+ void $ setSessionDynFlags dflags1++----------------------------------------------------------------++getHeaderExtension :: DynFlags -> FilePath -> IO [HeaderExt]+getHeaderExtension dflags file = map unLoc <$> getOptionsFromFile dflags file++----------------------------------------------------------------++getFastCheck :: DynFlags -> FilePath -> Maybe [LangExt] -> IO Bool+getFastCheck dflags file mLangExts = do+ hdrExts <- getHeaderExtension dflags file+ return . not $ useTemplateHaskell mLangExts hdrExts++useTemplateHaskell :: Maybe [LangExt] -> [HeaderExt] -> Bool+useTemplateHaskell mLangExts hdrExts = th1 || th2 where- d' = maySetExpose $ d {- importPaths = idirs- , ghcLink = LinkInMemory- , hscTarget = HscInterpreted- , flags = flags d+ th1 = "-XTemplateHaskell" `elem` hdrExts+ th2 = maybe False ("TemplateHaskell" `elem`) mLangExts++----------------------------------------------------------------++-- FIXME removing Options+modifyFlags :: DynFlags -> [IncludeDir] -> Maybe [Package] -> Bool -> Bool -> DynFlags+modifyFlags d0 idirs mDepPkgs fast splice+ | splice = setSplice d3+ | otherwise = d3+ where+ d1 = d0 { importPaths = idirs }+ d2 = setFastOrNot d1 fast+ d3 = maybe d2 (addDevPkgs d2) mDepPkgs++setSplice :: DynFlags -> DynFlags+setSplice dflag = dopt_set dflag Opt_D_dump_splices++setFastOrNot :: DynFlags -> Bool -> DynFlags+setFastOrNot dflags False = dflags {+ ghcLink = LinkInMemory+ , hscTarget = HscInterpreted+ }+setFastOrNot dflags True = dflags {+ ghcLink = NoLink+ , hscTarget = HscNothing+ }++addDevPkgs :: DynFlags -> [Package] -> DynFlags+addDevPkgs df pkgs = df''+ where+ df' = dopt_set df Opt_HideAllPackages+ df'' = df' {+ packageFlags = map ExposePackage pkgs ++ packageFlags df }- -- Do hide-all only when depend packages specified- maySetExpose df = maybe df (\x -> (dopt_set df Opt_HideAllPackages) {- packageFlags = map ExposePackage x ++ packageFlags df- }) mayPkgs -ghcPackage :: PackageFlag-ghcPackage = ExposePackage "ghc"+---------------------------------------------------------------- -setGhcFlags :: Monad m => Options -> DynFlags -> m DynFlags-setGhcFlags opt flagset =- do (flagset',_,_) <- parseDynamicFlags flagset (map noLoc (ghcOpts opt))- return flagset'+modifyFlagsWithOpts :: DynFlags -> [String] -> Ghc DynFlags+modifyFlagsWithOpts dflags cmdOpts =+ tfst <$> parseDynamicFlags dflags (map noLoc cmdOpts)+ where+ tfst (a,_,_) = a ---------------------------------------------------------------- @@ -76,3 +151,8 @@ setTargetFile file = do target <- guessTarget file Nothing setTargets [target]++----------------------------------------------------------------++getDynamicFlags :: IO DynFlags+getDynamicFlags = runGhc (Just libdir) getSessionDynFlags
GHCMod.hs view
@@ -3,15 +3,17 @@ module Main where import Browse-import CabalDev (modifyOptions)+import CabalApi import Check import Control.Applicative import Control.Exception+import Cradle import Data.Typeable import Data.Version+import Debug+import Flag import Info import Lang-import Flag import Lint import List import Paths_ghc_mod@@ -36,6 +38,7 @@ ++ "\t ghc-mod browse" ++ ghcOptHelp ++ "[-l] [-o] [-d] <module> [<module> ...]\n" ++ "\t ghc-mod check" ++ ghcOptHelp ++ "<HaskellFile>\n" ++ "\t ghc-mod expand" ++ ghcOptHelp ++ "<HaskellFile>\n"+ ++ "\t ghc-mod debug" ++ ghcOptHelp ++ "<HaskellFile>\n" ++ "\t ghc-mod info" ++ ghcOptHelp ++ "<HaskellFile> <module> <expression>\n" ++ "\t ghc-mod type" ++ ghcOptHelp ++ "<HaskellFile> <module> <line-no> <column-no>\n" ++ "\t ghc-mod lint [-h opt] <HaskellFile>\n"@@ -86,16 +89,23 @@ main = flip catches handlers $ do args <- getArgs let (opt',cmdArg) = parseArgs argspec args- opt <- modifyOptions opt'- res <- case safelist cmdArg 0 of+ (strVer,ver) <- getGHCVersion+ cradle <- findCradle (sandbox opt') strVer+ let opt = adjustOpts opt' cradle ver+ cmdArg0 = cmdArg !. 0+ cmdArg1 = cmdArg !. 1+ cmdArg2 = cmdArg !. 2+ cmdArg3 = cmdArg !. 3+ cmdArg4 = cmdArg !. 4+ res <- case cmdArg0 of "browse" -> concat <$> mapM (browseModule opt) (tail cmdArg) "list" -> listModules opt- "check" -> withFile (checkSyntax opt) (safelist cmdArg 1)- "expand" -> withFile (checkSyntax opt { expandSplice = True })- (safelist cmdArg 1)- "type" -> withFile (typeExpr opt (safelist cmdArg 2) (read $ safelist cmdArg 3) (read $ safelist cmdArg 4)) (safelist cmdArg 1)- "info" -> withFile (infoExpr opt (safelist cmdArg 2) (safelist cmdArg 3)) (safelist cmdArg 1)- "lint" -> withFile (lintSyntax opt) (safelist cmdArg 1)+ "check" -> withFile (checkSyntax opt cradle) cmdArg1+ "expand" -> withFile (checkSyntax opt { expandSplice = True } cradle) cmdArg1+ "debug" -> withFile (debugInfo opt cradle strVer) cmdArg1+ "type" -> withFile (typeExpr opt cradle cmdArg2 (read cmdArg3) (read cmdArg4)) cmdArg1+ "info" -> withFile (infoExpr opt cradle cmdArg2 cmdArg3) cmdArg1+ "lint" -> withFile (lintSyntax opt) cmdArg1 "lang" -> listLanguages opt "flag" -> listFlags opt "boot" -> do@@ -127,9 +137,16 @@ if exist then cmd file else throw (FileNotExist file)- safelist xs idx+ xs !. idx | length xs <= idx = throw SafeList | otherwise = xs !! idx+ adjustOpts opt cradle ver = case mPkgConf of+ Nothing -> opt+ Just pkgConf -> opt {+ ghcOpts = ghcPackageConfOptions ver pkgConf ++ ghcOpts opt+ }+ where+ mPkgConf = cradlePackageConf cradle ---------------------------------------------------------------- @@ -144,3 +161,9 @@ , "Data.Maybe" , "System.IO" ]+++ghcPackageConfOptions :: Int -> String -> [String]+ghcPackageConfOptions ver file+ | ver >= 706 = ["-package-db", file, "-no-user-package-conf"]+ | otherwise = ["-package-conf", file, "-no-user-package-conf"]
Info.hs view
@@ -3,7 +3,6 @@ module Info (infoExpr, typeExpr) where -import Cabal import Control.Applicative import CoreUtils import Data.Function@@ -23,8 +22,8 @@ import Outputable import PprTyThing import Pretty (showDocWith, Mode(OneLineMode))-import TcRnTypes import TcHsSyn (hsPatType)+import TcRnTypes import Types ----------------------------------------------------------------@@ -34,12 +33,12 @@ ---------------------------------------------------------------- -infoExpr :: Options -> ModuleString -> Expression -> FilePath -> IO String-infoExpr opt modstr expr file = (++ "\n") <$> info opt file modstr expr+infoExpr :: Options -> Cradle -> ModuleString -> Expression -> FilePath -> IO String+infoExpr opt cradle modstr expr file = (++ "\n") <$> info opt cradle file modstr expr -info :: Options -> FilePath -> ModuleString -> FilePath -> IO String-info opt fileName modstr expr =- inModuleContext opt fileName modstr exprToInfo "Cannot show info"+info :: Options -> Cradle -> FilePath -> ModuleString -> FilePath -> IO String+info opt cradle fileName modstr expr =+ inModuleContext opt cradle fileName modstr exprToInfo "Cannot show info" where exprToInfo = infoThing expr @@ -65,12 +64,12 @@ instance HasType (LPat Id) where getType _ (L spn pat) = return $ Just (spn, hsPatType pat) -typeExpr :: Options -> ModuleString -> Int -> Int -> FilePath -> IO String-typeExpr opt modstr lineNo colNo file = Info.typeOf opt file modstr lineNo colNo+typeExpr :: Options -> Cradle -> ModuleString -> Int -> Int -> FilePath -> IO String+typeExpr opt cradle modstr lineNo colNo file = Info.typeOf opt cradle file modstr lineNo colNo -typeOf :: Options -> FilePath -> ModuleString -> Int -> Int -> IO String-typeOf opt fileName modstr lineNo colNo =- inModuleContext opt fileName modstr exprToType errmsg+typeOf :: Options -> Cradle -> FilePath -> ModuleString -> Int -> Int -> IO String+typeOf opt cradle fileName modstr lineNo colNo =+ inModuleContext opt cradle fileName modstr exprToType errmsg where exprToType = do modSum <- getModSummary $ mkModuleName modstr@@ -138,17 +137,17 @@ ---------------------------------------------------------------- -inModuleContext :: Options -> FilePath -> ModuleString -> Ghc String -> String -> IO String-inModuleContext opt fileName modstr action errmsg =- withGHC (valid ||> invalid ||> return errmsg)+inModuleContext :: Options -> Cradle -> FilePath -> ModuleString -> Ghc String -> String -> IO String+inModuleContext opt cradle fileName modstr action errmsg =+ withGHCDummyFile (valid ||> invalid ||> return errmsg) where valid = do- (file,_) <- initializeGHC opt fileName ["-w"] False- setTargetFile file+ _ <- initializeFlagsWithCradle opt cradle fileName ["-w"] False+ setTargetFile fileName _ <- load LoadAllTargets doif setContextFromTarget action invalid = do- _ <- initializeGHC opt fileName ["-w"] False+ _ <- initializeFlagsWithCradle opt cradle fileName ["-w"] False setTargetBuffer _ <- load LoadAllTargets doif setContextFromTarget action
List.hs view
@@ -14,8 +14,8 @@ listModules opt = convert opt . nub . sort <$> list opt list :: Options -> IO [String]-list opt = withGHC $ do- _ <- initSession0 opt+list opt = withGHCDummyFile $ do+ initializeFlags opt getExposedModules <$> getSessionDynFlags where getExposedModules = map moduleNameString
Types.hs view
@@ -61,3 +61,20 @@ addNewLine :: String -> String addNewLine = (++ "\n")++----------------------------------------------------------------++data Cradle = Cradle {+ cradleCurrentDir :: FilePath+ , cradleCabalDir :: Maybe FilePath+ , cradleCabalFile :: Maybe FilePath+ , cradlePackageConf :: Maybe FilePath+ } deriving (Eq, Show)++----------------------------------------------------------------++type GHCOption = String+type IncludeDir = FilePath+type Package = String+type LangExt = String+type HeaderExt = String
elisp/ghc-flymake.el view
@@ -20,7 +20,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst ghc-flymake-allowed-file-name-masks- '("\\.l?hs$" ghc-flymake-init))+ '("\\.l?hs$" ghc-flymake-init nil ghc-emacs23-larter-hack)) (defconst ghc-flymake-err-line-patterns '("^\\(.*\\):\\([0-9]+\\):\\([0-9]+\\):[ ]*\\(.+\\)" 1 2 3 4))@@ -30,6 +30,23 @@ (add-to-list 'flymake-err-line-patterns ghc-flymake-err-line-patterns)++;; flymake of Emacs 23 or later does not display errors+;; if they occurred in other files. So, let's cheat flymake.+(defun ghc-emacs23-larter-hack (tmp-file)+ (let ((real-name (flymake-get-real-file-name tmp-file))+ (hack-name (flymake-get-real-file-name source-file-name)))+ (unless (string= real-name hack-name)+ ;; Change the local variable, line-err-info,+ ;; in flymake-parse-err-lines.+ (setq line-err-info+ (flymake-ler-make-ler+ nil+ 1+ (flymake-ler-type line-err-info)+ (concat real-name ": " (flymake-ler-text line-err-info))+ (flymake-ler-full-file line-err-info))))+ hack-name)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ghc-mod.cabal view
@@ -1,5 +1,5 @@ Name: ghc-mod-Version: 1.11.5+Version: 1.12.0 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -28,6 +28,7 @@ Extra-Source-Files: ChangeLog test/data/*.cabal test/data/*.hs+ test/data/cabal-dev/packages-7.6.2.conf test/data/ghc-mod-check/*.hs test/data/ghc-mod-check/*.cabal test/data/ghc-mod-check/Data/*.hs@@ -37,9 +38,9 @@ Main-Is: GHCMod.hs Other-Modules: Browse CabalApi- Cabal- CabalDev Check+ Cradle+ Debug ErrMsg Flag GHCApi@@ -65,7 +66,6 @@ , io-choice , old-time , process- , regex-posix , syb , time , transformers@@ -77,7 +77,6 @@ Type: exitcode-stdio-1.0 Other-Modules: Expectation BrowseSpec- CabalSpec CabalApiSpec CheckSpec FlagSpec@@ -98,7 +97,6 @@ , io-choice , old-time , process- , regex-posix , syb , time , transformers
test/BrowseSpec.hs view
@@ -17,3 +17,7 @@ it "lists up symbols with type info in the module" $ do syms <- lines <$> browseModule defaultOptions { detailed = True } "Data.Either" syms `shouldContain` "either :: (a -> c) -> (b -> c) -> Either a b -> c"++ it "lists up data constructors with type info in the module" $ do+ syms <- lines <$> browseModule defaultOptions { detailed = True} "Data.Either"+ syms `shouldContain` "Left :: a -> Either a b"
test/CabalApiSpec.hs view
@@ -1,17 +1,18 @@ module CabalApiSpec where +import Control.Applicative import Test.Hspec import CabalApi spec :: Spec spec = do- describe "cabalDependPackages" $ do+ describe "cabalAllDependPackages" $ do it "extracts dependent packages" $ do- pkgs <- cabalParseFile "test/data/cabalapi.cabal" >>= cabalDependPackages+ pkgs <- cabalAllDependPackages <$> cabalParseFile "test/data/cabalapi.cabal" pkgs `shouldBe` ["Cabal","base","containers","convertible","directory","filepath","ghc","ghc-paths","ghc-syb-utils","hlint","hspec","io-choice","old-time","process","regex-posix","syb","time","transformers"] describe "cabalBuildInfo" $ do it "extracts build info" $ do- info <- cabalParseFile "test/data/cabalapi.cabal" >>= cabalBuildInfo+ info <- cabalBuildInfo <$> cabalParseFile "test/data/cabalapi.cabal" let infoStr = show info infoStr `shouldBe` "BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [], otherModules = [ModuleName [\"Browse\"],ModuleName [\"CabalApi\"],ModuleName [\"Cabal\"],ModuleName [\"CabalDev\"],ModuleName [\"Check\"],ModuleName [\"ErrMsg\"],ModuleName [\"Flag\"],ModuleName [\"GHCApi\"],ModuleName [\"GHCChoice\"],ModuleName [\"Gap\"],ModuleName [\"Info\"],ModuleName [\"Lang\"],ModuleName [\"Lint\"],ModuleName [\"List\"],ModuleName [\"Paths_ghc_mod\"],ModuleName [\"Types\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [(GHC,[\"-Wall\"])], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = []}"
− test/CabalSpec.hs
@@ -1,23 +0,0 @@-module CabalSpec where--import Control.Applicative-import System.Directory-import Test.Hspec-import Cabal-import Expectation--spec :: Spec-spec = do- describe "getDirs" $ do- it "obtains two directories and a cabal file" $ do- len <- length <$> getCurrentDirectory- withDirectory "test/data/subdir1/subdir2" $ do- (x,y,z) <- getDirs- (drop len x, drop len y, drop len z) `shouldBe` ("/test/data/subdir1/subdir2","/test/data","/test/data/cabalapi.cabal")-- describe "getDirs" $ do- it "obtains two directories and a cabal file" $ do- len <- length <$> getCurrentDirectory- withDirectory "test/data/subdir1/subdir2" $ do- (x,y,z) <- fromCabal []- (x, map (drop len) y, z) `shouldBe` (["-XHaskell98"],["/test/data","/test/data/subdir1/subdir2"],["Cabal","base","containers","convertible","directory","filepath","ghc","ghc-paths","ghc-syb-utils","hlint","hspec","io-choice","old-time","process","regex-posix","syb","time","transformers"])
test/CheckSpec.hs view
@@ -1,14 +1,18 @@ module CheckSpec where -import Test.Hspec+import CabalApi import Check+import Cradle import Expectation+import Test.Hspec import Types spec :: Spec spec = do describe "checkSyntax" $ do it "can check even if an executable depends on its library" $ do- withDirectory "test/data/ghc-mod-check" $ do- res <- checkSyntax defaultOptions "main.hs"+ withDirectory_ "test/data/ghc-mod-check" $ do+ (strVer,_) <- getGHCVersion+ cradle <- findCradle Nothing strVer+ res <- checkSyntax defaultOptions cradle "main.hs" res `shouldBe` "main.hs:5:1:Warning: Top-level binding with no type signature: main :: IO ()\NUL\n"
test/Expectation.hs view
@@ -9,7 +9,12 @@ let res = element `elem` containers res `shouldBe` True -withDirectory :: FilePath -> IO a -> IO a+withDirectory_ :: FilePath -> IO a -> IO a+withDirectory_ dir action = bracket getCurrentDirectory+ setCurrentDirectory+ (\_ -> setCurrentDirectory dir >> action)++withDirectory :: FilePath -> (FilePath -> IO a) -> IO a withDirectory dir action = bracket getCurrentDirectory setCurrentDirectory- (\_ -> setCurrentDirectory dir >> action)+ (\d -> setCurrentDirectory dir >> action d)
test/InfoSpec.hs view
@@ -1,14 +1,18 @@ module InfoSpec where -import Test.Hspec+import CabalApi+import Cradle import Expectation import Info+import Test.Hspec import Types spec :: Spec spec = do describe "typeExpr" $ do it "shows types of the expression and its outers" $ do- withDirectory "test/data/ghc-mod-check" $ do- res <- typeExpr defaultOptions "Data.Foo" 9 5 "Data/Foo.hs"+ withDirectory_ "test/data/ghc-mod-check" $ do+ (strVer,_) <- getGHCVersion+ cradle <- findCradle Nothing strVer+ res <- typeExpr defaultOptions cradle "Data.Foo" 9 5 "Data/Foo.hs" res `shouldBe` "9 5 11 40 \"Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n"
+ test/data/cabal-dev/packages-7.6.2.conf view
@@ -0,0 +1,1 @@+dummy