packages feed

ghc-mod 3.1.3 → 3.1.4

raw patch · 12 files changed

+151/−58 lines, 12 files

Files

ChangeLog view
@@ -1,3 +1,11 @@+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)
Language/Haskell/GhcMod/Browse.hs view
@@ -4,9 +4,11 @@ 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@@ -25,19 +27,7 @@              -> Cradle              -> ModuleString -- ^ A module name. (e.g. \"Data.List\")              -> IO String-browseModule opt cradle mdlName = convert opt . format <$> withGHCDummyFile (browse opt cradle 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.@@ -50,28 +40,56 @@     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)+    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 -processExports :: ModuleInfo -> [String]-processExports = map getOccString . modInfoExports+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) -processModule :: ModuleInfo -> Ghc [String]-processModule minfo = mapM processName names+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@@ -82,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
Language/Haskell/GhcMod/ErrMsg.hs view
@@ -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)
Language/Haskell/GhcMod/Gap.hs view
@@ -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@@ -258,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,4 +284,40 @@     show_fixity fx       | 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
Language/Haskell/GhcMod/Info.hs view
@@ -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  ----------------------------------------------------------------
Language/Haskell/GhcMod/List.hs view
@@ -13,14 +13,21 @@  -- | Listing installed modules. listModules :: Options -> Cradle -> IO String-listModules opt cradle = convert opt . nub . sort <$> withGHCDummyFile (listMods opt cradle)+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 -> Cradle -> Ghc [String]+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)
Language/Haskell/GhcMod/Types.hs view
@@ -17,10 +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   -- | Line separator string.   , lineSeparator :: LineSeparator+  -- | Package id of module+  , packageId :: Maybe String   }  -- | A default 'Options'.@@ -31,8 +35,10 @@   , ghcOpts       = []   , operators     = False   , detailed      = False+  , qualified     = False   , expandSplice  = False   , lineSeparator = LineSeparator "\0"+  , packageId     = Nothing   }  ----------------------------------------------------------------
elisp/ghc-info.el view
@@ -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
elisp/ghc.el view
@@ -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")
ghc-mod.cabal view
@@ -1,5 +1,5 @@ Name:                   ghc-mod-Version:                3.1.3+Version:                3.1.4 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3@@ -64,7 +64,6 @@   Build-Depends:        base >= 4.0 && < 5                       , Cabal >= 1.10                       , containers-                      , convertible                       , directory                       , filepath                       , ghc@@ -77,6 +76,8 @@                       , syb                       , time                       , transformers+  if impl(ghc < 7.7)+    Build-Depends:      convertible  Executable ghc-mod   Default-Language:     Haskell2010@@ -117,7 +118,6 @@   Build-Depends:        base >= 4.0 && < 5                       , Cabal >= 1.10                       , containers-                      , convertible                       , directory                       , filepath                       , ghc@@ -131,8 +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+    Build-Depends:      executable-path  Source-Repository head   Type:                 git
src/GHCMod.hs view
@@ -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] <module> [<module> ...]\n"+        ++ "\t ghc-mod browse" ++ ghcOptHelp ++ "[-l] [-o] [-d] [-q] [-p package] <module> [<module> ...]\n"         ++ "\t ghc-mod check" ++ ghcOptHelp ++ "<HaskellFiles...>\n"         ++ "\t ghc-mod expand" ++ ghcOptHelp ++ "<HaskellFiles...>\n"         ++ "\t ghc-mod debug" ++ ghcOptHelp ++ "<HaskellFile>\n"@@ -55,6 +55,12 @@           , Option "d" ["detailed"]             (NoArg (\opts -> opts { detailed = True }))             "print detailed info"+          , 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)"
test/BrowseSpec.hs view
@@ -2,8 +2,11 @@  import Control.Applicative import Language.Haskell.GhcMod+import Language.Haskell.GhcMod.Cradle import Test.Hspec +import Dir+ spec :: Spec spec = do     describe "browseModule" $ do@@ -22,3 +25,10 @@             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"]