diff -Nru ghc-mod-3.0.2/ChangeLog ghc-mod-3.1.4/ChangeLog --- ghc-mod-3.0.2/ChangeLog 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/ChangeLog 2013-11-20 05:57:28.000000000 +0000 @@ -1,3 +1,21 @@ +2013-11-20 v3.1.3 + * GHCi loading as fallback for browse. (@khorser) + * Supporting GHC 7.7. (@schell) + * Introducing the "-p" and "-q" option for browse. (@mvoidex) + +2013-10-07 v3.1.3 + * Fixing tests. (@eagletmt) + +2013-09-21 v3.1.2 + * Supporting sandbox for "list" and "browse". (@eagletmt) + +2013-09-21 v3.1.1 + * Making Cradle strict. + +2013-09-21 v3.1.0 + * API breaks backward compatibility. + * Supporting sandbox sharing. + 2013-09-16 v3.0.2 * Fixing a bug of "dist/build/autogen/cabal_macros.h". diff -Nru ghc-mod-3.0.2/Language/Haskell/GhcMod/Browse.hs ghc-mod-3.1.4/Language/Haskell/GhcMod/Browse.hs --- ghc-mod-3.0.2/Language/Haskell/GhcMod/Browse.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/Language/Haskell/GhcMod/Browse.hs 2013-11-20 05:57:28.000000000 +0000 @@ -1,11 +1,14 @@ module Language.Haskell.GhcMod.Browse (browseModule, browse) where import Control.Applicative +import Control.Monad (void) import Data.Char import Data.List -import Data.Maybe (fromMaybe) +import Data.Maybe (catMaybes) import DataCon (dataConRepType) +import FastString (mkFastString) import GHC +import Panic(throwGhcException) import Language.Haskell.GhcMod.Doc (showUnqualifiedPage) import Language.Haskell.GhcMod.GHCApi import Language.Haskell.GhcMod.Types @@ -21,54 +24,72 @@ -- If 'detailed' is 'True', their types are also obtained. -- If 'operators' is 'True', operators are also returned. browseModule :: Options + -> Cradle -> ModuleString -- ^ A module name. (e.g. \"Data.List\") -> IO String -browseModule opt mdlName = convert opt . format <$> withGHCDummyFile (browse opt mdlName) - where - format - | operators opt = formatOps - | otherwise = removeOps - removeOps = sort . filter (isAlpha.head) - formatOps = sort . map formatOps' - formatOps' x@(s:_) - | isAlpha s = x - | otherwise = "(" ++ name ++ ")" ++ tail_ - where - (name, tail_) = break isSpace x - formatOps' [] = error "formatOps'" +browseModule opt cradle mdlName = convert opt . sort <$> withGHCDummyFile (browse opt cradle mdlName) -- | Getting functions, classes, etc from a module. -- If 'detailed' is 'True', their types are also obtained. -- If 'operators' is 'True', operators are also returned. browse :: Options + -> Cradle -> ModuleString -- ^ A module name. (e.g. \"Data.List\") -> Ghc [String] -browse opt mdlName = do - initializeFlags opt +browse opt cradle mdlName = do + void $ initializeFlagsWithCradle opt cradle [] False getModule >>= getModuleInfo >>= listExports where - getModule = findModule (mkModuleName mdlName) Nothing + getModule = findModule mdlname mpkgid `gcatch` fallback + mdlname = mkModuleName mdlName + mpkgid = mkFastString <$> packageId opt listExports Nothing = return [] - listExports (Just mdinfo) - | detailed opt = processModule mdinfo - | otherwise = return (processExports mdinfo) - -processExports :: ModuleInfo -> [String] -processExports = map getOccString . modInfoExports + listExports (Just mdinfo) = processExports opt mdinfo + -- findModule works only for package modules, moreover, + -- you cannot load a package module. On the other hand, + -- to browse a local module you need to load it first. + -- If CmdLineError is signalled, we assume the user + -- tried browsing a local module. + fallback (CmdLineError _) = loadAndFind + fallback e = throwGhcException e + loadAndFind = do + setTargetFiles [mdlName] + checkSlowAndSet + void $ load LoadAllTargets + findModule mdlname Nothing -processModule :: ModuleInfo -> Ghc [String] -processModule minfo = mapM processName names +processExports :: Options -> ModuleInfo -> Ghc [String] +processExports opt minfo = mapM (showExport opt minfo) $ removeOps $ modInfoExports minfo + where + removeOps + | operators opt = id + | otherwise = filter (isAlpha . head . getOccString) + +showExport :: Options -> ModuleInfo -> Name -> Ghc String +showExport opt minfo e = do + mtype' <- mtype + return $ concat $ catMaybes [mqualified, Just $ formatOp $ getOccString e, mtype'] where - names = modInfoExports minfo - processName :: Name -> Ghc String - processName nm = do - tyInfo <- modInfoLookupName minfo nm + mqualified = (moduleNameString (moduleName $ nameModule e) ++ ".") `justIf` qualified opt + mtype + | detailed opt = do + tyInfo <- modInfoLookupName minfo e -- If nothing found, load dependent module and lookup global - tyResult <- maybe (inOtherModule nm) (return . Just) tyInfo + tyResult <- maybe (inOtherModule e) (return . Just) tyInfo dflag <- getSessionDynFlags - return $ fromMaybe (getOccString nm) (tyResult >>= showThing dflag) + return $ do + typeName <- tyResult >>= showThing dflag + (" :: " ++ typeName) `justIf` detailed opt + | otherwise = return Nothing + formatOp nm@(n:_) + | isAlpha n = nm + | otherwise = "(" ++ nm ++ ")" + formatOp "" = error "formatOp" inOtherModule :: Name -> Ghc (Maybe TyThing) inOtherModule nm = getModuleInfo (nameModule nm) >> lookupGlobalName nm + justIf :: a -> Bool -> Maybe a + justIf x True = Just x + justIf _ False = Nothing showThing :: DynFlags -> TyThing -> Maybe String showThing dflag (AnId i) = Just $ formatType dflag varType i @@ -79,7 +100,7 @@ showThing _ _ = Nothing formatType :: NamedThing a => DynFlags -> (a -> Type) -> a -> String -formatType dflag f x = getOccString x ++ " :: " ++ showOutputable dflag (removeForAlls $ f x) +formatType dflag f x = showOutputable dflag (removeForAlls $ f x) tyType :: TyCon -> Maybe String tyType typ diff -Nru ghc-mod-3.0.2/Language/Haskell/GhcMod/CabalApi.hs ghc-mod-3.1.4/Language/Haskell/GhcMod/CabalApi.hs --- ghc-mod-3.0.2/Language/Haskell/GhcMod/CabalApi.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/Language/Haskell/GhcMod/CabalApi.hs 2013-11-20 05:57:28.000000000 +0000 @@ -1,19 +1,21 @@ {-# LANGUAGE OverloadedStrings #-} module Language.Haskell.GhcMod.CabalApi ( - fromCabalFile + getCompilerOptions , parseCabalFile , cabalAllBuildInfo , cabalDependPackages , cabalSourceDirs - , getGHCVersion + , cabalAllTargets ) where import Control.Applicative ((<$>)) import Control.Exception (throwIO) -import Data.List (intercalate) +import Control.Monad (filterM) +import CoreMonad (liftIO) import Data.Maybe (maybeToList) import Data.Set (fromList, toList) +import Distribution.ModuleName (ModuleName,toFilePath) import Distribution.Package (Dependency(Dependency) , PackageName(PackageName) , PackageIdentifier(pkgName)) @@ -26,34 +28,23 @@ import Distribution.System (buildPlatform) import Distribution.Text (display) import Distribution.Verbosity (silent) -import Distribution.Version (versionBranch, Version) +import Distribution.Version (Version) import Language.Haskell.GhcMod.Types import System.Directory (doesFileExist) import System.FilePath ---------------------------------------------------------------- --- | Parsing a cabal file in 'Cradle' and returns --- options for GHC, include directories for modules and --- package names of dependency. -fromCabalFile :: [GHCOption] - -> Cradle - -> IO ([GHCOption],[IncludeDir],[Package]) -fromCabalFile ghcOptions cradle = - parseCabalFile cfile >>= cookInfo ghcOptions cradle - where - Just cfile = cradleCabalFile cradle - -cookInfo :: [GHCOption] -> Cradle -> PackageDescription - -> IO ([GHCOption],[IncludeDir],[Package]) -cookInfo ghcOptions cradle cabal = do - gopts <- getGHCOptions ghcOptions cdir $ head buildInfos - return (gopts,idirs,depPkgs) +-- | Getting necessary 'CompilerOptions' from three information sources. +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 cabal + buildInfos = cabalAllBuildInfo pkgDesc idirs = includeDirectories cdir wdir $ cabalSourceDirs buildInfos depPkgs = removeThem problematicPackages $ removeMe cfile $ cabalDependPackages buildInfos @@ -77,12 +68,14 @@ -- Include directories for modules cabalBuildDirs :: [FilePath] -cabalBuildDirs = ["dist/build"] +cabalBuildDirs = ["dist/build", "dist/build/autogen"] includeDirectories :: FilePath -> FilePath -> [FilePath] -> [FilePath] includeDirectories cdir wdir dirs = uniqueAndSort (extdirs ++ [cdir,wdir]) where - extdirs = map (cdir ) $ dirs ++ cabalBuildDirs + extdirs = map expand $ dirs ++ cabalBuildDirs + expand "." = cdir + expand subdir = cdir subdir ---------------------------------------------------------------- @@ -105,12 +98,13 @@ ---------------------------------------------------------------- -getGHCOptions :: [GHCOption] -> FilePath -> BuildInfo -> IO [GHCOption] -getGHCOptions ghcOptions cdir binfo = do +getGHCOptions :: [GHCOption] -> Cradle -> FilePath -> BuildInfo -> IO [GHCOption] +getGHCOptions ghcopts cradle cdir binfo = do cabalCpp <- cabalCppOptions cdir let cpps = map ("-optP" ++) $ cppOptions binfo ++ cabalCpp - return $ ghcOptions ++ exts ++ [lang] ++ libs ++ libDirs ++ cpps + return $ ghcopts ++ pkgDb ++ exts ++ [lang] ++ libs ++ libDirs ++ cpps where + pkgDb = cradlePackageDbOpts cradle lang = maybe "-XHaskell98" (("-X" ++) . display) $ defaultLanguage binfo libDirs = map ("-L" ++) $ extraLibDirs binfo exts = map (("-X" ++) . display) $ usedExtensions binfo @@ -159,18 +153,6 @@ ---------------------------------------------------------------- --- | Getting GHC version. 7.6.3 becames 706 in the second of the result. -getGHCVersion :: IO (GHCVersion, Int) -getGHCVersion = toTupple <$> getGHC - where - toTupple v - | length vs < 2 = (verstr, 0) - | otherwise = (verstr, ver) - where - vs = versionBranch v - ver = (vs !! 0) * 100 + (vs !! 1) - verstr = intercalate "." . map show $ vs - getGHCId :: IO CompilerId getGHCId = CompilerId GHC <$> getGHC @@ -180,3 +162,41 @@ case mv of Nothing -> throwIO $ userError "ghc not found" Just v -> return $ v + +---------------------------------------------------------------- + +-- | Extracting all 'Module' 'FilePath's for libraries, executables, +-- tests and benchmarks. +cabalAllTargets :: PackageDescription -> IO ([String],[String],[String],[String]) +cabalAllTargets pd = do + exeTargets <- mapM getExecutableTarget $ executables pd + testTargets <- mapM getTestTarget $ testSuites pd + return (libTargets,concat exeTargets,concat testTargets,benchTargets) + where + lib = case library pd of + Nothing -> [] + Just l -> libModules l + + libTargets = map toModuleString $ lib + benchTargets = map toModuleString $ concatMap benchmarkModules $ benchmarks pd + + toModuleString :: ModuleName -> String + toModuleString mn = fromFilePath $ toFilePath mn + + fromFilePath :: FilePath -> String + fromFilePath fp = map (\c -> if c=='/' then '.' else c) fp + + getTestTarget :: TestSuite -> IO [String] + getTestTarget ts = + case testInterface ts of + (TestSuiteExeV10 _ filePath) -> do + let maybeTests = [p e | p <- hsSourceDirs $ testBuildInfo ts, e <- [filePath]] + liftIO $ filterM doesFileExist maybeTests + (TestSuiteLibV09 _ moduleName) -> return [toModuleString moduleName] + (TestSuiteUnsupported _) -> return [] + + getExecutableTarget :: Executable -> IO [String] + getExecutableTarget exe = do + let maybeExes = [p e | p <- hsSourceDirs $ buildInfo exe, e <- [modulePath exe]] + liftIO $ filterM doesFileExist maybeExes + diff -Nru ghc-mod-3.0.2/Language/Haskell/GhcMod/Check.hs ghc-mod-3.1.4/Language/Haskell/GhcMod/Check.hs --- ghc-mod-3.0.2/Language/Haskell/GhcMod/Check.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/Language/Haskell/GhcMod/Check.hs 2013-11-20 05:57:28.000000000 +0000 @@ -37,7 +37,7 @@ check opt cradle fileNames = checkIt `gcatch` handleErrMsg ls where checkIt = do - readLog <- initializeFlagsWithCradle opt cradle options True + (readLog,_) <- initializeFlagsWithCradle opt cradle options True setTargetFiles fileNames checkSlowAndSet void $ load LoadAllTargets diff -Nru ghc-mod-3.0.2/Language/Haskell/GhcMod/Cradle.hs ghc-mod-3.1.4/Language/Haskell/GhcMod/Cradle.hs --- ghc-mod-3.0.2/Language/Haskell/GhcMod/Cradle.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/Language/Haskell/GhcMod/Cradle.hs 2013-11-20 05:57:28.000000000 +0000 @@ -1,65 +1,55 @@ -module Language.Haskell.GhcMod.Cradle (findCradle) where +{-# LANGUAGE BangPatterns #-} +module Language.Haskell.GhcMod.Cradle ( + findCradle + , findCradleWithoutSandbox + , getPackageDbDir + ) where + +import Data.Char (isSpace) import Control.Applicative ((<$>)) -import Control.Exception (throwIO) -import Control.Monad (unless, filterM) -import Data.List (isSuffixOf) -import Distribution.System (buildPlatform) -import qualified Distribution.Text as Text (display) +import Control.Exception as E (catch, throwIO, SomeException) +import Control.Monad (filterM) +import Data.List (isPrefixOf, isSuffixOf, tails) import Language.Haskell.GhcMod.Types -import System.Directory (getCurrentDirectory, getDirectoryContents, doesFileExist, doesDirectoryExist) -import System.FilePath ((),takeDirectory) +import System.Directory (getCurrentDirectory, getDirectoryContents, doesFileExist) +import System.FilePath ((), takeDirectory, takeFileName) ---------------------------------------------------------------- -- | Finding 'Cradle'. --- An error would be thrown. -findCradle :: Maybe FilePath -- ^ A 'FilePath' for a sandbox. - -> GHCVersion - -> IO Cradle -findCradle (Just sbox) strver = do - (pkgConf,exist) <- checkPackageConf sbox strver - unless exist $ throwIO $ userError $ pkgConf ++ " not found" - 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 +-- Find a cabal file by tracing ancestor directories. +-- Find a sandbox according to a cabal sandbox config +-- in a cabal directory. +findCradle :: IO Cradle +findCradle = do wdir <- getCurrentDirectory - cfiles <- cabalDir wdir - case cfiles of - Nothing -> return Cradle { - cradleCurrentDir = wdir - , cradleCabalDir = Nothing - , cradleCabalFile = Nothing - , cradlePackageConf = Nothing - } - Just (cdir,cfile,Nothing) -> do - return Cradle { - cradleCurrentDir = wdir - , cradleCabalDir = Just cdir - , cradleCabalFile = Just cfile - , cradlePackageConf = Nothing - } - Just (cdir,cfile,Just sbox) -> do - (pkgConf,exist) <- checkPackageConf sbox strver - return Cradle { - cradleCurrentDir = wdir - , cradleCabalDir = Just cdir - , cradleCabalFile = Just cfile - , cradlePackageConf = if exist then Just pkgConf else Nothing - } + findCradle' wdir `E.catch` handler wdir + where + handler :: FilePath -> SomeException -> IO Cradle + handler wdir _ = return Cradle { + cradleCurrentDir = wdir + , cradleCabalDir = Nothing + , cradleCabalFile = Nothing + , cradlePackageDbOpts = [] + } + +findCradle' :: FilePath -> IO Cradle +findCradle' wdir = do + (cdir,cfile) <- cabalDir wdir + pkgDbOpts <- getPackageDbOpts cdir + return Cradle { + cradleCurrentDir = wdir + , cradleCabalDir = Just cdir + , cradleCabalFile = Just cfile + , cradlePackageDbOpts = pkgDbOpts + } + +-- Just for testing +findCradleWithoutSandbox :: IO Cradle +findCradleWithoutSandbox = do + cradle <- findCradle + return cradle { cradlePackageDbOpts = [] } ---------------------------------------------------------------- @@ -72,52 +62,80 @@ -- Finding a Cabal file up to the root directory -- Input: a directly to investigate -- Output: (the path to the directory containing a Cabal file --- ,the path to the Cabal file --- ,Just the path to the sandbox directory) -cabalDir :: FilePath -> IO (Maybe (FilePath,FilePath,Maybe FilePath)) +-- ,the path to the Cabal file) +cabalDir :: FilePath -> IO (FilePath,FilePath) cabalDir dir = do - cnts <- (filter isCabal <$> getDirectoryContents dir) - >>= filterM (\file -> doesFileExist (dir file)) - let dir' = takeDirectory dir + cnts <- getCabalFiles dir case cnts of - [] | dir' == dir -> return Nothing + [] | dir' == dir -> throwIO $ userError "cabal files not found" | otherwise -> cabalDir dir' - cfile:_ -> do - msbox <- checkSandbox dir - return $ Just (dir,dir cfile, msbox) + cfile:_ -> return (dir,dir cfile) + where + dir' = takeDirectory dir + +getCabalFiles :: FilePath -> IO [FilePath] +getCabalFiles dir = getFiles >>= filterM doesCabalFileExist where isCabal name = cabalSuffix `isSuffixOf` name && length name > cabalSuffixLength + getFiles = filter isCabal <$> getDirectoryContents dir + doesCabalFileExist file = doesFileExist $ dir file ---------------------------------------------------------------- -sandboxConfig :: String -sandboxConfig = "cabal.sandbox.config" +configFile :: String +configFile = "cabal.sandbox.config" -sandboxDir :: String -sandboxDir = ".cabal-sandbox" +pkgDbKey :: String +pkgDbKey = "package-db:" -checkSandbox :: FilePath -> IO (Maybe FilePath) -checkSandbox dir = do - let conf = dir sandboxConfig - sbox = dir sandboxDir - sandboxConfigExists <- doesFileExist conf - sandboxExists <- doesDirectoryExist sbox - if sandboxConfigExists && sandboxExists then - return (Just sbox) - else - return Nothing +pkgDbKeyLen :: Int +pkgDbKeyLen = length pkgDbKey ----------------------------------------------------------------- +-- | Obtaining GHC options relating to a package db directory +getPackageDbOpts :: FilePath -> IO [GHCOption] +getPackageDbOpts cdir = (sandboxArguments <$> getPkgDb) `E.catch` handler + where + getPkgDb = getPackageDbDir (cdir configFile) + handler :: SomeException -> IO [GHCOption] + handler _ = return [] + +-- | Extract a package db directory from the sandbox config file. +-- Exception is thrown if the sandbox config file is broken. +getPackageDbDir :: FilePath -> IO FilePath +getPackageDbDir sconf = do + -- Be strict to ensure that an error can be caught. + !path <- extractValue . parse <$> readFile sconf + return path + where + parse = head . filter ("package-db:" `isPrefixOf`) . lines + extractValue = fst . break isSpace . dropWhile isSpace . drop pkgDbKeyLen -packageConfName :: GHCVersion -> FilePath -packageConfName strver = Text.display buildPlatform - ++ "-ghc-" - ++ strver - ++ "-packages.conf.d" - -checkPackageConf :: FilePath -> GHCVersion -> IO (FilePath, Bool) -checkPackageConf path strver = do - let dir = path packageConfName strver - exist <- doesDirectoryExist dir - return (dir,exist) +-- | Adding necessary GHC options to the package db. +-- Exception is thrown if the string argument is incorrect. +-- +-- >>> sandboxArguments "/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d" +-- ["-no-user-package-db","-package-db","/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d"] +-- >>> sandboxArguments "/foo/bar/i386-osx-ghc-7.4.1-packages.conf.d" +-- ["-no-user-package-conf","-package-conf","/foo/bar/i386-osx-ghc-7.4.1-packages.conf.d"] +sandboxArguments :: FilePath -> [String] +sandboxArguments pkgDb = [noUserPkgDbOpt, pkgDbOpt, pkgDb] + where + ver = extractGhcVer pkgDb + (pkgDbOpt,noUserPkgDbOpt) + | ver < 706 = ("-package-conf","-no-user-package-conf") + | otherwise = ("-package-db", "-no-user-package-db") + +-- | Extracting GHC version from the path of package db. +-- Exception is thrown if the string argument is incorrect. +-- +-- >>> extractGhcVer "/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d" +-- 706 +extractGhcVer :: String -> Int +extractGhcVer dir = ver + where + file = takeFileName dir + findVer = drop 4 . head . filter ("ghc-" `isPrefixOf`) . tails + (verStr1,_:left) = break (== '.') $ findVer file + (verStr2,_) = break (== '.') left + ver = read verStr1 * 100 + read verStr2 diff -Nru ghc-mod-3.0.2/Language/Haskell/GhcMod/Debug.hs ghc-mod-3.1.4/Language/Haskell/GhcMod/Debug.hs --- ghc-mod-3.0.2/Language/Haskell/GhcMod/Debug.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/Language/Haskell/GhcMod/Debug.hs 2013-11-20 05:57:28.000000000 +0000 @@ -17,30 +17,27 @@ -- | Obtaining debug information. debugInfo :: Options -> Cradle - -> GHCVersion -> FilePath -- ^ A target file. -> IO String -debugInfo opt cradle ver fileName = unlines <$> withGHC fileName (debug opt cradle ver fileName) +debugInfo opt cradle fileName = unlines <$> withGHC fileName (debug opt cradle fileName) -- | Obtaining debug information. debug :: Options -> Cradle - -> GHCVersion -> FilePath -- ^ A target file. -> Ghc [String] -debug opt cradle ver fileName = do - (gopts, incDir, pkgs) <- +debug opt cradle fileName = do + CompilerOptions gopts incDir pkgs <- if cabal then - liftIO $ fromCabalFile (ghcOpts opt) cradle ||> return (ghcOpts opt, [], []) + liftIO (fromCabalFile ||> return simpleCompilerOption) else - return (ghcOpts opt, [], []) + return simpleCompilerOption [fast] <- do void $ initializeFlagsWithCradle opt cradle gopts True setTargetFiles [fileName] pure . canCheckFast <$> depanal [] False return [ - "GHC version: " ++ ver - , "Current directory: " ++ currentDir + "Current directory: " ++ currentDir , "Cabal file: " ++ cabalFile , "GHC options: " ++ unwords gopts , "Include directories: " ++ unwords incDir @@ -49,5 +46,11 @@ ] where currentDir = cradleCurrentDir cradle - cabal = isJust $ cradleCabalFile cradle - cabalFile = fromMaybe "" $ cradleCabalFile cradle + mCabalFile = cradleCabalFile cradle + cabal = isJust mCabalFile + cabalFile = fromMaybe "" mCabalFile + origGopts = ghcOpts opt + simpleCompilerOption = CompilerOptions origGopts [] [] + fromCabalFile = parseCabalFile file >>= getCompilerOptions origGopts cradle + where + file = fromJust mCabalFile diff -Nru ghc-mod-3.0.2/Language/Haskell/GhcMod/ErrMsg.hs ghc-mod-3.1.4/Language/Haskell/GhcMod/ErrMsg.hs --- ghc-mod-3.0.2/Language/Haskell/GhcMod/ErrMsg.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/Language/Haskell/GhcMod/ErrMsg.hs 2013-11-20 05:57:28.000000000 +0000 @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, CPP #-} module Language.Haskell.GhcMod.ErrMsg ( LogReader @@ -55,7 +55,7 @@ ppErrMsg :: DynFlags -> LineSeparator -> ErrMsg -> String ppErrMsg dflag ls err = ppMsg spn SevError dflag ls msg ++ ext where - spn = head (errMsgSpans err) + spn = Gap.errorMsgSpan err msg = errMsgShortDoc err ext = showMsg dflag ls (errMsgExtraInfo err) diff -Nru ghc-mod-3.0.2/Language/Haskell/GhcMod/GHCApi.hs ghc-mod-3.1.4/Language/Haskell/GhcMod/GHCApi.hs --- ghc-mod-3.0.2/Language/Haskell/GhcMod/GHCApi.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/Language/Haskell/GhcMod/GHCApi.hs 2013-11-20 05:57:28.000000000 +0000 @@ -16,7 +16,8 @@ import Control.Exception import Control.Monad import CoreMonad -import Data.Maybe (isJust) +import Data.Maybe (isJust,fromJust) +import Distribution.PackageDescription (PackageDescription) import DynFlags import Exception import GHC @@ -24,8 +25,8 @@ import Language.Haskell.GhcMod.CabalApi import Language.Haskell.GhcMod.ErrMsg import Language.Haskell.GhcMod.GHCChoice -import Language.Haskell.GhcMod.Types import qualified Language.Haskell.GhcMod.Gap as Gap +import Language.Haskell.GhcMod.Types import System.Exit import System.IO @@ -60,37 +61,44 @@ -- | Initialize the 'DynFlags' relating to the compilation of a single -- file or GHC session according to the 'Cradle' and 'Options' -- provided. -initializeFlagsWithCradle :: GhcMonad m => Options -> Cradle -> [GHCOption] -> Bool -> m LogReader -initializeFlagsWithCradle opt cradle ghcOptions logging +initializeFlagsWithCradle :: GhcMonad m => Options -> Cradle -> [GHCOption] -> Bool -> m (LogReader, Maybe PackageDescription) +initializeFlagsWithCradle opt cradle ghcopts logging | cabal = withCabal |||> withoutCabal | otherwise = withoutCabal where - cabal = isJust $ cradleCabalFile cradle + mCradleFile = cradleCabalFile cradle + cabal = isJust mCradleFile withCabal = do - (gopts,idirs,depPkgs) <- liftIO $ fromCabalFile ghcOptions cradle - initSession CabalPkg opt gopts idirs (Just depPkgs) logging - withoutCabal = - initSession SingleFile opt ghcOptions importDirs Nothing logging + pkgDesc <- liftIO $ parseCabalFile $ fromJust mCradleFile + compOpts <- liftIO $ getCompilerOptions ghcopts cradle pkgDesc + logger <- initSession CabalPkg opt compOpts logging + return (logger, Just pkgDesc) + withoutCabal = do + logger <- initSession SingleFile opt compOpts logging + return (logger, Nothing) + where + compOpts = CompilerOptions ghcopts importDirs [] ---------------------------------------------------------------- initSession :: GhcMonad m => Build -> Options - -> [GHCOption] - -> [IncludeDir] - -> Maybe [Package] + -> CompilerOptions -> Bool -> m LogReader -initSession build opt cmdOpts idirs mDepPkgs logging = do +initSession build opt compOpts logging = do dflags0 <- getSessionDynFlags (dflags1,readLog) <- setupDynamicFlags dflags0 _ <- setSessionDynFlags dflags1 return readLog where + cmdOpts = ghcOptions compOpts + idirs = includeDirs compOpts + depPkgs = depPackages compOpts ls = lineSeparator opt setupDynamicFlags df0 = do df1 <- modifyFlagsWithOpts df0 cmdOpts - let df2 = modifyFlags df1 idirs mDepPkgs (expandSplice opt) build + let df2 = modifyFlags df1 idirs depPkgs (expandSplice opt) build df3 <- modifyFlagsWithOpts df2 $ ghcOpts opt liftIO $ setLogger logging df3 ls @@ -107,14 +115,14 @@ ---------------------------------------------------------------- -- FIXME removing Options -modifyFlags :: DynFlags -> [IncludeDir] -> Maybe [Package] -> Bool -> Build -> DynFlags -modifyFlags d0 idirs mDepPkgs splice build +modifyFlags :: DynFlags -> [IncludeDir] -> [Package] -> Bool -> Build -> DynFlags +modifyFlags d0 idirs depPkgs splice build | splice = setSplice d4 | otherwise = d4 where d1 = d0 { importPaths = idirs } d2 = setFastOrNot d1 Fast - d3 = maybe d2 (Gap.addDevPkgs d2) mDepPkgs + d3 = Gap.addDevPkgs d2 depPkgs d4 | build == CabalPkg = Gap.setCabalPkg d3 | otherwise = d3 diff -Nru ghc-mod-3.0.2/Language/Haskell/GhcMod/Gap.hs ghc-mod-3.1.4/Language/Haskell/GhcMod/Gap.hs --- ghc-mod-3.0.2/Language/Haskell/GhcMod/Gap.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/Language/Haskell/GhcMod/Gap.hs 2013-11-20 05:57:28.000000000 +0000 @@ -19,6 +19,9 @@ , infoThing , pprInfo , HasType(..) + , errorMsgSpan + , typeForUser + , deSugar #if __GLASGOW_HASKELL__ >= 702 #else , module Pretty @@ -30,6 +33,7 @@ import Data.List import Data.Maybe import Data.Time.Clock +import Desugar (deSugarExpr) import DynFlags import ErrUtils import FastString @@ -41,6 +45,8 @@ import PprTyThing import StringBuffer import TcType +import TcRnTypes +import CoreSyn import qualified InstEnv import qualified Pretty @@ -207,6 +213,7 @@ ---------------------------------------------------------------- addDevPkgs :: DynFlags -> [Package] -> DynFlags +addDevPkgs df [] = df addDevPkgs df pkgs = df'' where #if __GLASGOW_HASKELL__ >= 707 @@ -257,9 +264,9 @@ return $ vcat (intersperse (text "") $ map (pprInfo False) filtered) #if __GLASGOW_HASKELL__ >= 707 -pprInfo :: PrintExplicitForalls -> (TyThing, GHC.Fixity, [ClsInst], [FamInst]) -> SDoc -pprInfo pefas (thing, fixity, insts, famInsts) - = pprTyThingInContextLoc pefas thing +pprInfo :: Bool -> (TyThing, GHC.Fixity, [ClsInst], [FamInst]) -> SDoc +pprInfo _ (thing, fixity, insts, famInsts) + = pprTyThingInContextLoc thing $$ show_fixity fixity $$ InstEnv.pprInstances insts $$ pprFamInsts famInsts @@ -278,3 +285,39 @@ | fx == defaultFixity = Outputable.empty | otherwise = ppr fx <+> ppr (getName thing) #endif + +---------------------------------------------------------------- +---------------------------------------------------------------- + +errorMsgSpan :: ErrMsg -> SrcSpan +#if __GLASGOW_HASKELL__ >= 707 +errorMsgSpan = errMsgSpan +#else +errorMsgSpan = head . errMsgSpans +#endif + +typeForUser :: Type -> SDoc +#if __GLASGOW_HASKELL__ >= 707 +typeForUser = pprTypeForUser +#else +typeForUser = pprTypeForUser False +#endif + +deSugar :: TypecheckedModule -> LHsExpr Id -> HscEnv + -> IO (Maybe CoreSyn.CoreExpr) +#if __GLASGOW_HASKELL__ >= 707 +deSugar tcm e hs_env = snd <$> deSugarExpr hs_env modu rn_env ty_env fi_env e + where + modu = ms_mod $ pm_mod_summary $ tm_parsed_module tcm + tcgEnv = fst $ tm_internals_ tcm + rn_env = tcg_rdr_env tcgEnv + ty_env = tcg_type_env tcgEnv + fi_env = tcg_fam_inst_env tcgEnv +#else +deSugar tcm e hs_env = snd <$> deSugarExpr hs_env modu rn_env ty_env e + where + modu = ms_mod $ pm_mod_summary $ tm_parsed_module tcm + tcgEnv = fst $ tm_internals_ tcm + rn_env = tcg_rdr_env tcgEnv + ty_env = tcg_type_env tcgEnv +#endif diff -Nru ghc-mod-3.0.2/Language/Haskell/GhcMod/Info.hs ghc-mod-3.1.4/Language/Haskell/GhcMod/Info.hs --- ghc-mod-3.0.2/Language/Haskell/GhcMod/Info.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/Language/Haskell/GhcMod/Info.hs 2013-11-20 05:57:28.000000000 +0000 @@ -1,4 +1,4 @@ -{-# LANGUAGE TupleSections, FlexibleInstances, TypeSynonymInstances #-} +{-# LANGUAGE TupleSections, FlexibleInstances, TypeSynonymInstances, CPP #-} {-# LANGUAGE Rank2Types #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -18,7 +18,6 @@ import Data.Maybe import Data.Ord as O import Data.Time.Clock -import Desugar import GHC import GHC.SYB.Utils import HscTypes @@ -29,9 +28,7 @@ import Language.Haskell.GhcMod.Gap (HasType(..)) import Language.Haskell.GhcMod.Types import Outputable -import PprTyThing import TcHsSyn (hsPatType) -import TcRnTypes ---------------------------------------------------------------- @@ -68,12 +65,8 @@ instance HasType (LHsExpr Id) where getType tcm e = do hs_env <- getSession - (_, mbe) <- Gap.liftIO $ deSugarExpr hs_env modu rn_env ty_env e + mbe <- Gap.liftIO $ Gap.deSugar tcm e hs_env return $ (getLoc e, ) <$> CoreUtils.exprType <$> mbe - where - modu = ms_mod $ pm_mod_summary $ tm_parsed_module tcm - rn_env = tcg_rdr_env $ fst $ tm_internals_ tcm - ty_env = tcg_type_env $ fst $ tm_internals_ tcm instance HasType (LPat Id) where getType _ (L spn pat) = return $ Just (spn, hsPatType pat) @@ -137,7 +130,7 @@ listifyStaged s p = everythingStaged s (++) [] ([] `mkQ` (\x -> [x | p x])) pretty :: DynFlags -> Type -> String -pretty dflag = showUnqualifiedOneLine dflag . pprTypeForUser False +pretty dflag = showUnqualifiedOneLine dflag . Gap.typeForUser ---------------------------------------------------------------- diff -Nru ghc-mod-3.0.2/Language/Haskell/GhcMod/Internal.hs ghc-mod-3.1.4/Language/Haskell/GhcMod/Internal.hs --- ghc-mod-3.0.2/Language/Haskell/GhcMod/Internal.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/Language/Haskell/GhcMod/Internal.hs 2013-11-20 05:57:28.000000000 +0000 @@ -6,12 +6,14 @@ , GHCOption , Package , IncludeDir + , CompilerOptions(..) -- * Cabal API - , fromCabalFile , parseCabalFile + , getCompilerOptions , cabalAllBuildInfo , cabalDependPackages , cabalSourceDirs + , cabalAllTargets -- * GHC API , canCheckFast -- * Getting 'DynFlags' diff -Nru ghc-mod-3.0.2/Language/Haskell/GhcMod/List.hs ghc-mod-3.1.4/Language/Haskell/GhcMod/List.hs --- ghc-mod-3.0.2/Language/Haskell/GhcMod/List.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/Language/Haskell/GhcMod/List.hs 2013-11-20 05:57:28.000000000 +0000 @@ -1,6 +1,7 @@ module Language.Haskell.GhcMod.List (listModules, listMods) where import Control.Applicative +import Control.Monad (void) import Data.List import GHC import Language.Haskell.GhcMod.GHCApi @@ -11,15 +12,22 @@ ---------------------------------------------------------------- -- | Listing installed modules. -listModules :: Options -> IO String -listModules opt = convert opt . nub . sort <$> withGHCDummyFile (listMods opt) +listModules :: Options -> Cradle -> IO String +listModules opt cradle = convert opt . nub . sort . map dropPkgs <$> withGHCDummyFile (listMods opt cradle) + where + dropPkgs (name, pkg) + | detailed opt = name ++ " " ++ pkg + | otherwise = name -- | Listing installed modules. -listMods :: Options -> Ghc [String] -listMods opt = do - initializeFlags opt +listMods :: Options -> Cradle -> Ghc [(String, String)] +listMods opt cradle = do + void $ initializeFlagsWithCradle opt cradle [] False getExposedModules <$> getSessionDynFlags where - getExposedModules = map moduleNameString - . concatMap exposedModules + getExposedModules = concatMap exposedModules' . eltsUFM . pkgIdMap . pkgState + exposedModules' p = + map moduleNameString (exposedModules p) + `zip` + repeat (display $ sourcePackageId p) diff -Nru ghc-mod-3.0.2/Language/Haskell/GhcMod/Types.hs ghc-mod-3.1.4/Language/Haskell/GhcMod/Types.hs --- ghc-mod-3.0.2/Language/Haskell/GhcMod/Types.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/Language/Haskell/GhcMod/Types.hs 2013-11-20 05:57:28.000000000 +0000 @@ -17,12 +17,14 @@ , operators :: Bool -- | If 'True', 'browse' also returns types. , detailed :: Bool + -- | If 'True', 'browse' will return fully qualified name + , qualified :: Bool -- | Whether or not Template Haskell should be expanded. , expandSplice :: Bool - -- | The sandbox directory. - , sandbox :: Maybe FilePath -- | Line separator string. , lineSeparator :: LineSeparator + -- | Package id of module + , packageId :: Maybe String } -- | A default 'Options'. @@ -33,9 +35,10 @@ , ghcOpts = [] , operators = False , detailed = False + , qualified = False , expandSplice = False - , sandbox = Nothing , lineSeparator = LineSeparator "\0" + , packageId = Nothing } ---------------------------------------------------------------- @@ -85,24 +88,21 @@ , cradleCabalDir :: Maybe FilePath -- | The file name of the found cabal file. , cradleCabalFile :: Maybe FilePath - -- | The sandbox directory. (e.g. \"\/foo\/bar\/packages-\.conf/\") - , cradlePackageConf :: Maybe FilePath + -- | The package db options. ([\"-no-user-package-db\",\"-package-db\",\"\/foo\/bar\/i386-osx-ghc-7.6.3-packages.conf.d\"]) + , cradlePackageDbOpts :: [GHCOption] } deriving (Eq, Show) ---------------------------------------------------------------- --- | A single GHC option, as it would appear on the command line. +-- | A single GHC command line option. type GHCOption = String --- | Include directories for modules +-- | An include directory for modules. type IncludeDir = FilePath --- | Package names +-- | A package name. type Package = String --- | GHC version in 'String'. -type GHCVersion = String - -- | Haskell expression. type Expression = String @@ -110,3 +110,10 @@ type ModuleString = String data CheckSpeed = Slow | Fast + +-- | Option information for GHC +data CompilerOptions = CompilerOptions { + ghcOptions :: [GHCOption] -- ^ Command line options + , includeDirs :: [IncludeDir] -- ^ Include directories for modules + , depPackages :: [Package] -- ^ Dependent package names + } deriving (Eq, Show) diff -Nru ghc-mod-3.0.2/Language/Haskell/GhcMod.hs ghc-mod-3.1.4/Language/Haskell/GhcMod.hs --- ghc-mod-3.0.2/Language/Haskell/GhcMod.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/Language/Haskell/GhcMod.hs 2013-11-20 05:57:28.000000000 +0000 @@ -4,9 +4,6 @@ -- * Cradle Cradle(..) , findCradle - -- * GHC version - , GHCVersion - , getGHCVersion -- * Options , Options(..) , LineSeparator(..) @@ -48,4 +45,3 @@ import Language.Haskell.GhcMod.Lint import Language.Haskell.GhcMod.List import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.CabalApi diff -Nru ghc-mod-3.0.2/debian/changelog ghc-mod-3.1.4/debian/changelog --- ghc-mod-3.0.2/debian/changelog 2013-09-16 11:56:52.000000000 +0000 +++ ghc-mod-3.1.4/debian/changelog 2013-12-05 10:21:46.000000000 +0000 @@ -1,3 +1,13 @@ +ghc-mod (3.1.4-1) unstable; urgency=low + + [ Joachim Breitner ] + * Adjust watch file to new hackage layout + + [ Kiwamu Okabe ] + * New upstream version. + + -- Kiwamu Okabe Thu, 05 Dec 2013 18:54:46 +0900 + ghc-mod (3.0.2-1) unstable; urgency=low * New upstream version. diff -Nru ghc-mod-3.0.2/debian/watch ghc-mod-3.1.4/debian/watch --- ghc-mod-3.0.2/debian/watch 2011-08-28 09:02:30.000000000 +0000 +++ ghc-mod-3.1.4/debian/watch 2013-12-05 09:52:32.000000000 +0000 @@ -1,5 +1,2 @@ version=3 -opts="downloadurlmangle=s|archive/([\w\d_-]+)/([\d\.]+)/|archive/$1/$2/$1-$2.tar.gz|,\ -filenamemangle=s|(.*)/$|ghc-mod-$1.tar.gz|" \ - http://hackage.haskell.org/packages/archive/ghc-mod \ - ([\d\.]*\d)/ +http://hackage.haskell.org/package/ghc-mod/distro-monitor .*-([0-9\.]+).(?:zip|tgz|tbz|txz|(?:tar\.(?:gz|bz2|xz))) diff -Nru ghc-mod-3.0.2/elisp/ghc-info.el ghc-mod-3.1.4/elisp/ghc-info.el --- ghc-mod-3.0.2/elisp/ghc-info.el 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/elisp/ghc-info.el 2013-11-20 05:57:28.000000000 +0000 @@ -111,7 +111,7 @@ (defun ghc-type-obtain-tinfos (modname) (let* ((ln (int-to-string (line-number-at-pos))) - (cn (int-to-string (current-column))) + (cn (int-to-string (1+ (current-column)))) (cdir default-directory) (file (buffer-file-name))) (ghc-read-lisp diff -Nru ghc-mod-3.0.2/elisp/ghc.el ghc-mod-3.1.4/elisp/ghc.el --- ghc-mod-3.0.2/elisp/ghc.el 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/elisp/ghc.el 2013-11-20 05:57:28.000000000 +0000 @@ -33,9 +33,10 @@ ;;; (defun ghc-find-C-h () - (if keyboard-translate-table - (aref keyboard-translate-table ?\C-h) - ?\C-h)) + (or + (when keyboard-translate-table + (aref keyboard-translate-table ?\C-h)) + ?\C-h)) (defvar ghc-completion-key "\e\t") (defvar ghc-document-key "\e\C-d") diff -Nru ghc-mod-3.0.2/ghc-mod.cabal ghc-mod-3.1.4/ghc-mod.cabal --- ghc-mod-3.0.2/ghc-mod.cabal 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/ghc-mod.cabal 2013-11-20 05:57:28.000000000 +0000 @@ -1,5 +1,5 @@ Name: ghc-mod -Version: 3.0.2 +Version: 3.1.4 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 @@ -28,14 +28,17 @@ test/data/*.hs test/data/cabal.sandbox.config test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/dummy - test/data/ghc-mod-check/*.hs - test/data/ghc-mod-check/*.cabal - test/data/ghc-mod-check/Data/*.hs - test/data/subdir1/subdir2/dummy + test/data/broken-cabal/*.cabal + test/data/broken-sandbox/*.cabal + test/data/broken-sandbox/cabal.sandbox.config test/data/check-test-subdir/*.cabal + test/data/check-test-subdir/src/Check/Test/*.hs test/data/check-test-subdir/test/*.hs test/data/check-test-subdir/test/Bar/*.hs - test/data/check-test-subdir/src/Check/Test/*.hs + test/data/ghc-mod-check/*.cabal + test/data/ghc-mod-check/*.hs + test/data/ghc-mod-check/Data/*.hs + test/data/subdir1/subdir2/dummy Library Default-Language: Haskell2010 @@ -61,7 +64,6 @@ Build-Depends: base >= 4.0 && < 5 , Cabal >= 1.10 , containers - , convertible , directory , filepath , ghc @@ -74,6 +76,8 @@ , syb , time , transformers + if impl(ghc < 7.7) + Build-Depends: convertible Executable ghc-mod Default-Language: Haskell2010 @@ -87,6 +91,15 @@ , ghc , ghc-mod +Test-Suite doctest + Type: exitcode-stdio-1.0 + Default-Language: Haskell2010 + HS-Source-Dirs: test + Ghc-Options: -threaded -Wall + Main-Is: doctests.hs + Build-Depends: base + , doctest >= 0.9.3 + Test-Suite spec Default-Language: Haskell2010 Main-Is: Spec.hs @@ -105,7 +118,6 @@ Build-Depends: base >= 4.0 && < 5 , Cabal >= 1.10 , containers - , convertible , directory , filepath , ghc @@ -119,6 +131,10 @@ , time , transformers , hspec >= 1.7.1 + if impl(ghc < 7.7) + Build-Depends: convertible + if impl(ghc < 7.6.0) + Build-Depends: executable-path Source-Repository head Type: git diff -Nru ghc-mod-3.0.2/src/GHCMod.hs ghc-mod-3.1.4/src/GHCMod.hs --- ghc-mod-3.0.2/src/GHCMod.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/src/GHCMod.hs 2013-11-20 05:57:28.000000000 +0000 @@ -24,10 +24,10 @@ usage :: String usage = "ghc-mod version " ++ showVersion version ++ "\n" ++ "Usage:\n" - ++ "\t ghc-mod list" ++ ghcOptHelp ++ "[-l]\n" + ++ "\t ghc-mod list" ++ ghcOptHelp ++ "[-l] [-d]\n" ++ "\t ghc-mod lang [-l]\n" ++ "\t ghc-mod flag [-l]\n" - ++ "\t ghc-mod browse" ++ ghcOptHelp ++ "[-l] [-o] [-d] [ ...]\n" + ++ "\t ghc-mod browse" ++ ghcOptHelp ++ "[-l] [-o] [-d] [-q] [-p package] [ ...]\n" ++ "\t ghc-mod check" ++ ghcOptHelp ++ "\n" ++ "\t ghc-mod expand" ++ ghcOptHelp ++ "\n" ++ "\t ghc-mod debug" ++ ghcOptHelp ++ "\n" @@ -55,9 +55,12 @@ , Option "d" ["detailed"] (NoArg (\opts -> opts { detailed = True })) "print detailed info" - , Option "s" ["sandbox"] - (ReqArg (\s opts -> opts { sandbox = Just s }) "path") - "specify a sandbox" + , Option "q" ["qualified"] + (NoArg (\opts -> opts { qualified = True })) + "show qualified names" + , Option "p" ["package"] + (ReqArg (\p opts -> opts { packageId = Just p, ghcOpts = ("-package " ++ p) : ghcOpts opts }) "package-id") + "specify package of module" , Option "b" ["boundary"] (ReqArg (\s opts -> opts { lineSeparator = LineSeparator s }) "sep") "specify line separator (default is Nul string)" @@ -87,11 +90,9 @@ hSetEncoding stdout utf8 -- #endif args <- getArgs - let (opt',cmdArg) = parseArgs argspec args - (strVer,ver) <- getGHCVersion - cradle <- findCradle (sandbox opt') strVer - let opt = adjustOpts opt' cradle ver - cmdArg0 = cmdArg !. 0 + let (opt,cmdArg) = parseArgs argspec args + cradle <- findCradle + let cmdArg0 = cmdArg !. 0 cmdArg1 = cmdArg !. 1 cmdArg2 = cmdArg !. 2 cmdArg3 = cmdArg !. 3 @@ -101,21 +102,21 @@ then f else throw (TooManyArguments cmdArg0) res <- case cmdArg0 of - "browse" -> concat <$> mapM (browseModule opt) remainingArgs - "list" -> listModules opt + "browse" -> concat <$> mapM (browseModule opt cradle) remainingArgs + "list" -> listModules opt cradle "check" -> checkSyntax opt cradle remainingArgs "expand" -> checkSyntax opt { expandSplice = True } cradle remainingArgs - "debug" -> nArgs 1 $ debugInfo opt cradle strVer cmdArg1 + "debug" -> nArgs 1 $ debugInfo opt cradle cmdArg1 "type" -> nArgs 4 $ typeExpr opt cradle cmdArg1 cmdArg2 (read cmdArg3) (read cmdArg4) "info" -> nArgs 3 infoExpr opt cradle cmdArg1 cmdArg2 cmdArg3 "lint" -> nArgs 1 withFile (lintSyntax opt) cmdArg1 "lang" -> listLanguages opt "flag" -> listFlags opt "boot" -> do - mods <- listModules opt + mods <- listModules opt cradle langs <- listLanguages opt flags <- listFlags opt - pre <- concat <$> mapM (browseModule opt) preBrowsedModules + pre <- concat <$> mapM (browseModule opt cradle) preBrowsedModules return $ mods ++ langs ++ flags ++ pre "help" -> return $ usageInfo usage argspec cmd -> throw (NoSuchCommand cmd) @@ -148,13 +149,6 @@ 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 ---------------------------------------------------------------- @@ -169,9 +163,3 @@ , "Data.Maybe" , "System.IO" ] - - -ghcPackageConfOptions :: Int -> String -> [String] -ghcPackageConfOptions ver file - | ver >= 706 = ["-package-db", file, "-no-user-package-db"] - | otherwise = ["-package-conf", file, "-no-user-package-conf"] diff -Nru ghc-mod-3.0.2/test/BrowseSpec.hs ghc-mod-3.1.4/test/BrowseSpec.hs --- ghc-mod-3.0.2/test/BrowseSpec.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/test/BrowseSpec.hs 2013-11-20 05:57:28.000000000 +0000 @@ -2,20 +2,33 @@ import Control.Applicative import Language.Haskell.GhcMod +import Language.Haskell.GhcMod.Cradle import Test.Hspec +import Dir + spec :: Spec spec = do describe "browseModule" $ do it "lists up symbols in the module" $ do - syms <- lines <$> browseModule defaultOptions "Data.Map" + cradle <- findCradle + syms <- lines <$> browseModule defaultOptions cradle "Data.Map" syms `shouldContain` ["differenceWithKey"] describe "browseModule -d" $ do it "lists up symbols with type info in the module" $ do - syms <- lines <$> browseModule defaultOptions { detailed = True } "Data.Either" + cradle <- findCradle + syms <- lines <$> browseModule defaultOptions { detailed = True } cradle "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" + cradle <- findCradle + syms <- lines <$> browseModule defaultOptions { detailed = True} cradle "Data.Either" syms `shouldContain` ["Left :: a -> Either a b"] + + describe "browseModule local" $ do + it "lists symbols in a local module" $ do + withDirectory_ "test/data" $ do + cradle <- findCradleWithoutSandbox + syms <- lines <$> browseModule defaultOptions cradle "Baz" + syms `shouldContain` ["baz"] diff -Nru ghc-mod-3.0.2/test/CabalApiSpec.hs ghc-mod-3.1.4/test/CabalApiSpec.hs --- ghc-mod-3.0.2/test/CabalApiSpec.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/test/CabalApiSpec.hs 2013-11-20 05:57:28.000000000 +0000 @@ -4,15 +4,32 @@ import Control.Applicative import Control.Exception +import Data.Maybe import Language.Haskell.GhcMod.CabalApi +import Language.Haskell.GhcMod.Cradle +import Language.Haskell.GhcMod.Types import Test.Hspec +import Dir + spec :: Spec spec = do describe "parseCabalFile" $ do it "throws an exception if the cabal file is broken" $ do parseCabalFile "test/data/broken-cabal/broken.cabal" `shouldThrow` (\(_::IOException) -> True) + describe "getCompilerOptions" $ do + it "gets necessary CompilerOptions" $ do + withDirectory "test/data/subdir1/subdir2" $ \dir -> do + cradle <- findCradle + pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile cradle + res <- getCompilerOptions [] cradle pkgDesc + let res' = res { + ghcOptions = ghcOptions res + , includeDirs = map (toRelativeDir dir) (includeDirs res) + } + res' `shouldBe` CompilerOptions {ghcOptions = ["-no-user-package-db","-package-db","/home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d","-XHaskell98"], includeDirs = ["test/data","test/data/dist/build","test/data/dist/build/autogen","test/data/subdir1/subdir2","test/data/test"], depPackages = ["Cabal","base","template-haskell"]} + describe "cabalDependPackages" $ do it "extracts dependent packages" $ do pkgs <- cabalDependPackages . cabalAllBuildInfo <$> parseCabalFile "test/data/cabalapi.cabal" @@ -22,8 +39,11 @@ it "extracts all hs-source-dirs" $ do dirs <- cabalSourceDirs . cabalAllBuildInfo <$> parseCabalFile "test/data/check-test-subdir/check-test-subdir.cabal" dirs `shouldBe` ["src", "test"] + it "extracts all hs-source-dirs including \".\"" $ do + dirs <- cabalSourceDirs . cabalAllBuildInfo <$> parseCabalFile "test/data/cabalapi.cabal" + dirs `shouldBe` [".", "test"] - describe "cabalBuildInfo" $ do + describe "cabalAllBuildInfo" $ do it "extracts build info" $ do info <- cabalAllBuildInfo <$> parseCabalFile "test/data/cabalapi.cabal" show info `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 = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []}))),Dependency (PackageName \"template-haskell\") AnyVersion]},BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [\"test\",\".\"], otherModules = [ModuleName [\"Expectation\"],ModuleName [\"BrowseSpec\"],ModuleName [\"CabalApiSpec\"],ModuleName [\"FlagSpec\"],ModuleName [\"LangSpec\"],ModuleName [\"LintSpec\"],ModuleName [\"ListSpec\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []})))]}]" diff -Nru ghc-mod-3.0.2/test/CheckSpec.hs ghc-mod-3.1.4/test/CheckSpec.hs --- ghc-mod-3.0.2/test/CheckSpec.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/test/CheckSpec.hs 2013-11-20 05:57:28.000000000 +0000 @@ -2,6 +2,7 @@ import Data.List (isSuffixOf, isInfixOf, isPrefixOf) import Language.Haskell.GhcMod +import Language.Haskell.GhcMod.Cradle import System.FilePath import Test.Hspec @@ -12,26 +13,24 @@ describe "checkSyntax" $ do it "can check even if an executable depends on its library" $ do withDirectory_ "test/data/ghc-mod-check" $ do - (strVer,_) <- getGHCVersion - cradle <- findCradle Nothing strVer + cradle <- findCradleWithoutSandbox res <- checkSyntax defaultOptions cradle ["main.hs"] res `shouldBe` "main.hs:5:1:Warning: Top-level binding with no type signature: main :: IO ()\NUL\n" it "can check even if a test module imports another test module located at different directory" $ do withDirectory_ "test/data/check-test-subdir" $ do - cradle <- getGHCVersion >>= findCradle Nothing . fst + cradle <- findCradleWithoutSandbox res <- checkSyntax defaultOptions cradle ["test/Bar/Baz.hs"] res `shouldSatisfy` (("test" "Foo.hs:3:1:Warning: Top-level binding with no type signature: foo :: [Char]\NUL\n") `isSuffixOf`) it "can detect mutually imported modules" $ do withDirectory_ "test/data" $ do - (strVer,_) <- getGHCVersion - cradle <- findCradle Nothing strVer + cradle <- findCradleWithoutSandbox res <- checkSyntax defaultOptions cradle ["Mutual1.hs"] res `shouldSatisfy` ("Module imports form a cycle" `isInfixOf`) it "can check a module using QuasiQuotes" $ do withDirectory_ "test/data" $ do - cradle <- getGHCVersion >>= findCradle Nothing . fst + cradle <- findCradleWithoutSandbox res <- checkSyntax defaultOptions cradle ["Baz.hs"] res `shouldSatisfy` ("Baz.hs:5:1:Warning:" `isPrefixOf`) diff -Nru ghc-mod-3.0.2/test/DebugSpec.hs ghc-mod-3.1.4/test/DebugSpec.hs --- ghc-mod-3.0.2/test/DebugSpec.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/test/DebugSpec.hs 2013-11-20 05:57:28.000000000 +0000 @@ -7,9 +7,8 @@ checkFast :: String -> String -> IO () checkFast file ans = withDirectory_ "test/data" $ do - (strVer,_) <- getGHCVersion - cradle <- findCradle Nothing strVer - res <- debugInfo defaultOptions cradle strVer file + let cradle = Cradle "." Nothing Nothing [] + res <- debugInfo defaultOptions cradle file lines res `shouldContain` [ans] spec :: Spec diff -Nru ghc-mod-3.0.2/test/Dir.hs ghc-mod-3.1.4/test/Dir.hs --- ghc-mod-3.0.2/test/Dir.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/test/Dir.hs 2013-11-20 05:57:28.000000000 +0000 @@ -1,7 +1,9 @@ module Dir where -import System.Directory import Control.Exception as E +import Data.List (isPrefixOf) +import System.Directory +import System.FilePath (addTrailingPathSeparator) withDirectory_ :: FilePath -> IO a -> IO a withDirectory_ dir action = bracket getCurrentDirectory @@ -12,3 +14,11 @@ withDirectory dir action = bracket getCurrentDirectory setCurrentDirectory (\d -> setCurrentDirectory dir >> action d) + +toRelativeDir :: FilePath -> FilePath -> FilePath +toRelativeDir dir file + | dir' `isPrefixOf` file = drop len file + | otherwise = file + where + dir' = addTrailingPathSeparator dir + len = length dir' diff -Nru ghc-mod-3.0.2/test/InfoSpec.hs ghc-mod-3.1.4/test/InfoSpec.hs --- ghc-mod-3.0.2/test/InfoSpec.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/test/InfoSpec.hs 2013-11-20 05:57:28.000000000 +0000 @@ -1,8 +1,17 @@ +{-# LANGUAGE CPP #-} module InfoSpec where +import Control.Applicative ((<$>)) import Data.List (isPrefixOf) import Language.Haskell.GhcMod +import Language.Haskell.GhcMod.Cradle +#if __GLASGOW_HASKELL__ < 706 +import System.Environment.Executable (getExecutablePath) +#else +import System.Environment (getExecutablePath) +#endif import System.Exit +import System.FilePath import System.Process import Test.Hspec @@ -13,42 +22,45 @@ describe "typeExpr" $ do it "shows types of the expression and its outers" $ do withDirectory_ "test/data/ghc-mod-check" $ do - (strVer,_) <- getGHCVersion - cradle <- findCradle Nothing strVer + cradle <- findCradleWithoutSandbox res <- typeExpr defaultOptions cradle "Data/Foo.hs" "Data.Foo" 9 5 res `shouldBe` "9 5 11 40 \"Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n" it "works with a module using TemplateHaskell" $ do withDirectory_ "test/data" $ do - cradle <- getGHCVersion >>= findCradle Nothing . fst + cradle <- findCradleWithoutSandbox res <- typeExpr defaultOptions cradle "Bar.hs" "Bar" 5 1 res `shouldBe` unlines ["5 1 5 20 \"[Char]\""] it "works with a module that imports another module using TemplateHaskell" $ do withDirectory_ "test/data" $ do - cradle <- getGHCVersion >>= findCradle Nothing . fst + cradle <- findCradleWithoutSandbox res <- typeExpr defaultOptions cradle "Main.hs" "Main" 3 8 res `shouldBe` unlines ["3 8 3 16 \"String -> IO ()\"", "3 8 3 20 \"IO ()\"", "3 1 3 20 \"IO ()\""] describe "infoExpr" $ do it "works for non-export functions" $ do withDirectory_ "test/data" $ do - cradle <- getGHCVersion >>= findCradle Nothing . fst + cradle <- findCradleWithoutSandbox res <- infoExpr defaultOptions cradle "Info.hs" "Info" "fib" res `shouldSatisfy` ("fib :: Int -> Int" `isPrefixOf`) it "works with a module using TemplateHaskell" $ do withDirectory_ "test/data" $ do - cradle <- getGHCVersion >>= findCradle Nothing . fst + cradle <- findCradleWithoutSandbox res <- infoExpr defaultOptions cradle "Bar.hs" "Bar" "foo" res `shouldSatisfy` ("foo :: ExpQ" `isPrefixOf`) it "works with a module that imports another module using TemplateHaskell" $ do withDirectory_ "test/data" $ do - cradle <- getGHCVersion >>= findCradle Nothing . fst + cradle <- findCradleWithoutSandbox res <- infoExpr defaultOptions cradle "Main.hs" "Main" "bar" res `shouldSatisfy` ("bar :: [Char]" `isPrefixOf`) it "doesn't fail on unicode output" $ do - code <- rawSystem "dist/build/ghc-mod/ghc-mod" ["info", "test/data/Unicode.hs", "Unicode", "unicode"] + dir <- getDistDir + code <- rawSystem (dir "build/ghc-mod/ghc-mod") ["info", "test/data/Unicode.hs", "Unicode", "unicode"] code `shouldSatisfy` (== ExitSuccess) + +getDistDir :: IO FilePath +getDistDir = takeDirectory . takeDirectory . takeDirectory <$> getExecutablePath diff -Nru ghc-mod-3.0.2/test/ListSpec.hs ghc-mod-3.1.4/test/ListSpec.hs --- ghc-mod-3.0.2/test/ListSpec.hs 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/test/ListSpec.hs 2013-11-20 05:57:28.000000000 +0000 @@ -8,5 +8,6 @@ spec = do describe "listModules" $ do it "lists up module names" $ do - modules <- lines <$> listModules defaultOptions + cradle <- findCradle + modules <- lines <$> listModules defaultOptions cradle modules `shouldContain` ["Data.Map"] diff -Nru ghc-mod-3.0.2/test/data/broken-cabal/broken.cabal ghc-mod-3.1.4/test/data/broken-cabal/broken.cabal --- ghc-mod-3.0.2/test/data/broken-cabal/broken.cabal 1970-01-01 00:00:00.000000000 +0000 +++ ghc-mod-3.1.4/test/data/broken-cabal/broken.cabal 2013-11-20 05:57:28.000000000 +0000 @@ -0,0 +1 @@ +broken cabal diff -Nru ghc-mod-3.0.2/test/data/broken-sandbox/cabal.sandbox.config ghc-mod-3.1.4/test/data/broken-sandbox/cabal.sandbox.config --- ghc-mod-3.0.2/test/data/broken-sandbox/cabal.sandbox.config 1970-01-01 00:00:00.000000000 +0000 +++ ghc-mod-3.1.4/test/data/broken-sandbox/cabal.sandbox.config 2013-11-20 05:57:28.000000000 +0000 @@ -0,0 +1 @@ +broken diff -Nru ghc-mod-3.0.2/test/data/broken-sandbox/dummy.cabal ghc-mod-3.1.4/test/data/broken-sandbox/dummy.cabal --- ghc-mod-3.0.2/test/data/broken-sandbox/dummy.cabal 1970-01-01 00:00:00.000000000 +0000 +++ ghc-mod-3.1.4/test/data/broken-sandbox/dummy.cabal 2013-11-20 05:57:28.000000000 +0000 @@ -0,0 +1 @@ +dummy diff -Nru ghc-mod-3.0.2/test/data/cabal.sandbox.config ghc-mod-3.1.4/test/data/cabal.sandbox.config --- ghc-mod-3.0.2/test/data/cabal.sandbox.config 2013-09-16 03:08:12.000000000 +0000 +++ ghc-mod-3.1.4/test/data/cabal.sandbox.config 2013-11-20 05:57:28.000000000 +0000 @@ -4,15 +4,15 @@ -- if you want to change the default settings for this sandbox. -local-repo: /Users/kazu/work/ghc-mod/test/data/.cabal-sandbox/packages -logs-dir: /Users/kazu/work/ghc-mod/test/data/.cabal-sandbox/logs -world-file: /Users/kazu/work/ghc-mod/test/data/.cabal-sandbox/world +local-repo: /home/me/work/ghc-mod/test/data/.cabal-sandbox/packages +logs-dir: /home/me/work/ghc-mod/test/data/.cabal-sandbox/logs +world-file: /home/me/work/ghc-mod/test/data/.cabal-sandbox/world user-install: False -package-db: /Users/kazu/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d -build-summary: /Users/kazu/work/ghc-mod/test/data/.cabal-sandbox/logs/build.log +package-db: /home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d +build-summary: /home/me/work/ghc-mod/test/data/.cabal-sandbox/logs/build.log install-dirs - prefix: /Users/kazu/work/ghc-mod/test/data/.cabal-sandbox + prefix: /home/me/work/ghc-mod/test/data/.cabal-sandbox bindir: $prefix/bin libdir: $prefix/lib libsubdir: $arch-$os-$compiler/$pkgid diff -Nru ghc-mod-3.0.2/test/doctests.hs ghc-mod-3.1.4/test/doctests.hs --- ghc-mod-3.0.2/test/doctests.hs 1970-01-01 00:00:00.000000000 +0000 +++ ghc-mod-3.1.4/test/doctests.hs 2013-11-20 05:57:28.000000000 +0000 @@ -0,0 +1,10 @@ +module Main where + +import Test.DocTest + +main :: IO () +main = doctest [ + "-package" + , "ghc" + , "Language/Haskell/GhcMod.hs" + ]