ghc-mod 1.11.0 → 1.11.1
raw patch · 15 files changed
+117/−64 lines, 15 filesdep +convertibledep +time
Dependencies added: convertible, time
Files
- Browse.hs +1/−1
- CabalDev.hs +4/−3
- Check.hs +3/−3
- ErrMsg.hs +4/−4
- GHCApi.hs +1/−1
- Gap.hs +78/−3
- Info.hs +13/−10
- List.hs +1/−1
- elisp/ghc-command.el +1/−1
- elisp/ghc-comp.el +2/−2
- elisp/ghc-func.el +0/−11
- elisp/ghc-indent.el +2/−16
- elisp/ghc-info.el +2/−2
- elisp/ghc-ins-mod.el +1/−1
- ghc-mod.cabal +4/−5
Browse.hs view
@@ -25,7 +25,7 @@ browse :: Options -> String -> IO [String] browse opt mdlName = withGHC $ do- initSession0 opt+ _ <- initSession0 opt maybeNamesToStrings <$> lookupModuleInfo where lookupModuleInfo = findModule (mkModuleName mdlName) Nothing >>= getModuleInfo
CabalDev.hs view
@@ -37,9 +37,10 @@ searchIt :: [FilePath] -> IO FilePath searchIt [] = throwIO $ userError "Not found" searchIt path = do- a <- doesDirectoryExist (mpath path)- if a then- findConf (mpath path)+ let cabalDir = mpath path+ exist <- doesDirectoryExist cabalDir+ if exist then+ findConf cabalDir else searchIt $ init path where
Check.hs view
@@ -7,7 +7,7 @@ import Exception import GHC import GHCApi-import Prelude hiding (catch)+import Prelude import Types ----------------------------------------------------------------@@ -23,8 +23,8 @@ checkIt = do (file,readLog) <- initializeGHC opt fileName options True setTargetFile file- load LoadAllTargets+ _ <- load LoadAllTargets liftIO readLog options | expandSplice opt = ["-w:"] ++ ghcOpts opt- | otherwise = ["-Wall","-fno-warn-unused-do-bind"] ++ ghcOpts opt+ | otherwise = ["-Wall"] ++ ghcOpts opt
ErrMsg.hs view
@@ -24,13 +24,13 @@ setLogger :: Bool -> DynFlags -> IO (DynFlags, LogReader) setLogger False df = return (newdf, undefined) where- newdf = df { log_action = \_ _ _ _ -> return () }+ newdf = Gap.setLogAction df $ \_ _ _ _ _ -> return () setLogger True df = do ref <- newIORef [] :: IO (IORef [String])- let newdf = df { log_action = appendLog ref }+ let newdf = Gap.setLogAction df $ appendLog ref return (newdf, reverse <$> readIORef ref) where- appendLog ref _ src stl msg = modifyIORef ref (\ls -> ppMsg src msg stl : ls)+ appendLog ref _ _ src stl msg = modifyIORef ref (\ls -> ppMsg src msg stl : ls) ---------------------------------------------------------------- @@ -49,7 +49,7 @@ msg = errMsgShortDoc err ext = showMsg (errMsgExtraInfo err) defaultUserStyle -ppMsg :: SrcSpan -> Message -> PprStyle -> String+ppMsg :: SrcSpan -> SDoc -> PprStyle -> String ppMsg spn msg stl = fromMaybe def $ do (line,col,_,_) <- Gap.getSrcSpan spn file <- Gap.getSrcFile spn
GHCApi.hs view
@@ -37,7 +37,7 @@ let opts = map noLoc cmdOpts (dflags',_,_) <- parseDynamicFlags dflags opts (dflags'',readLog) <- liftIO . (>>= setLogger logging) . setGhcFlags opt . setFlags opt dflags' $ idirs- setSessionDynFlags dflags''+ _ <- setSessionDynFlags dflags'' return readLog ----------------------------------------------------------------
Gap.hs view
@@ -1,7 +1,13 @@ {-# LANGUAGE CPP #-} module Gap (- supportedExtensions+ Gap.ClsInst+ , mkTarget+ , showDocForUser+ , showDoc+ , styleDoc+ , setLogAction+ , supportedExtensions , getSrcSpan , getSrcFile , renderMsg@@ -18,7 +24,9 @@ import Control.Applicative hiding (empty) import Control.Monad+import Data.Time.Clock import DynFlags+import ErrUtils import FastString import GHC import GHCChoice@@ -26,6 +34,11 @@ import Outputable import StringBuffer +import qualified InstEnv+import qualified Pretty+import qualified StringBuffer as SB++ #if __GLASGOW_HASKELL__ >= 702 import CoreMonad (liftIO) #else@@ -33,6 +46,11 @@ import Pretty #endif +#if __GLASGOW_HASKELL__ < 706+import Control.Arrow+import Data.Convertible+#endif+ {- pretty :: Outputable a => a -> String pretty = showSDocForUser neverQualify . ppr@@ -43,7 +61,57 @@ ---------------------------------------------------------------- ----------------------------------------------------------------+--+#if __GLASGOW_HASKELL__ >= 706+type ClsInst = InstEnv.ClsInst+#else+type ClsInst = InstEnv.Instance+#endif +mkTarget :: TargetId -> Bool -> Maybe (SB.StringBuffer, UTCTime) -> Target+#if __GLASGOW_HASKELL__ >= 706+mkTarget = Target+#else+mkTarget tid allowObjCode = Target tid allowObjCode . (fmap . second) convert+#endif++----------------------------------------------------------------+----------------------------------------------------------------++showDocForUser :: PrintUnqualified -> SDoc -> String+#if __GLASGOW_HASKELL__ >= 706+showDocForUser = showSDocForUser tracingDynFlags+#else+showDocForUser = showSDocForUser+#endif++showDoc :: SDoc -> String+#if __GLASGOW_HASKELL__ >= 706+showDoc = showSDoc tracingDynFlags+#else+showDoc = showSDoc+#endif++styleDoc :: PprStyle -> SDoc -> Pretty.Doc+#if __GLASGOW_HASKELL__ >= 706+styleDoc = withPprStyleDoc tracingDynFlags+#else+styleDoc = withPprStyleDoc+#endif++setLogAction :: DynFlags+ -> (DynFlags -> Severity -> SrcSpan -> PprStyle -> SDoc -> IO ())+ -> DynFlags+setLogAction df f =+#if __GLASGOW_HASKELL__ >= 706+ df { log_action = f }+#else+ df { log_action = f df }+#endif++----------------------------------------------------------------+----------------------------------------------------------------+ supportedExtensions :: [String] #if __GLASGOW_HASKELL__ >= 700 supportedExtensions = supportedLanguagesAndExtensions@@ -77,7 +145,9 @@ ---------------------------------------------------------------- renderMsg :: SDoc -> PprStyle -> String-#if __GLASGOW_HASKELL__ >= 702+#if __GLASGOW_HASKELL__ >= 706+renderMsg d stl = renderWithStyle tracingDynFlags d stl+#elif __GLASGOW_HASKELL__ >= 702 renderMsg d stl = renderWithStyle d stl #else renderMsg d stl = Pretty.showDocWith PageMode $ d stl@@ -111,7 +181,12 @@ setCtx :: [ModSummary] -> Ghc Bool #if __GLASGOW_HASKELL__ >= 704 setCtx ms = do- top <- map (IIModule . ms_mod) <$> filterM isTop ms+#if __GLASGOW_HASKELL__ >= 706+ let modName = IIModule . moduleName . ms_mod+#else+ let modName = IIModule . ms_mod+#endif+ top <- map modName <$> filterM isTop ms setContext top return (not . null $ top) #else
Info.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE TupleSections, FlexibleInstances, TypeSynonymInstances #-}+{-# LANGUAGE Rank2Types #-} module Info (infoExpr, typeExpr) where @@ -10,6 +11,7 @@ import Data.List import Data.Maybe import Data.Ord as O+import Data.Time.Clock import Desugar import GHC import GHC.SYB.Utils@@ -21,7 +23,6 @@ import Outputable import PprTyThing import Pretty (showDocWith, Mode(OneLineMode))-import System.Time import TcRnTypes import TcHsSyn (hsPatType) import Types@@ -106,7 +107,7 @@ listifyStaged s p = everythingStaged s (++) [] ([] `mkQ` (\x -> [x | p x])) pretty :: Type -> String-pretty = showDocWith OneLineMode . withPprStyleDoc (mkUserStyle neverQualify AllTheWay) . pprTypeForUser False+pretty = showDocWith OneLineMode . Gap.styleDoc (mkUserStyle neverQualify AllTheWay) . pprTypeForUser False ---------------------------------------------------------------- -- from ghc/InteractiveUI.hs@@ -117,7 +118,7 @@ mb_stuffs <- mapM getInfo names let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs) unqual <- getPrintUnqual- return $ showSDocForUser unqual $ vcat (intersperse (text "") $ map (pprInfo False) filtered)+ return $ Gap.showDocForUser unqual $ vcat (intersperse (text "") $ map (pprInfo False) filtered) filterOutChildren :: (a -> TyThing) -> [a] -> [a] filterOutChildren get_thing xs@@ -125,7 +126,7 @@ where implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)] -pprInfo :: PrintExplicitForalls -> (TyThing, GHC.Fixity, [Instance]) -> SDoc+pprInfo :: PrintExplicitForalls -> (TyThing, GHC.Fixity, [Gap.ClsInst]) -> SDoc pprInfo pefas (thing, fixity, insts) = pprTyThingInContextLoc pefas thing $$ show_fixity fixity@@ -144,22 +145,24 @@ valid = do (file,_) <- initializeGHC opt fileName ["-w"] False setTargetFile file- load LoadAllTargets+ _ <- load LoadAllTargets doif setContextFromTarget action invalid = do- initializeGHC opt fileName ["-w"] False+ _ <- initializeGHC opt fileName ["-w"] False setTargetBuffer- load LoadAllTargets+ _ <- load LoadAllTargets doif setContextFromTarget action setTargetBuffer = do modgraph <- depanal [mkModuleName modstr] True- let imports = concatMap (map (showSDoc . ppr . unLoc)) $+ let imports = concatMap (map (Gap.showDoc . ppr . unLoc)) $ map ms_imps modgraph ++ map ms_srcimps modgraph moddef = "module " ++ sanitize modstr ++ " where" header = moddef : imports importsBuf <- Gap.toStringBuffer header- clkTime <- Gap.liftIO getClockTime- setTargets [Target (TargetModule $ mkModuleName modstr) True (Just (importsBuf, clkTime))]+ clkTime <- Gap.liftIO getCurrentTime+ setTargets [Gap.mkTarget (TargetModule $ mkModuleName modstr)+ True+ (Just (importsBuf, clkTime))] doif m t = m >>= \ok -> if ok then t else goNext sanitize = fromMaybe "SomeModule" . listToMaybe . words
List.hs view
@@ -15,7 +15,7 @@ list :: Options -> IO [String] list opt = withGHC $ do- initSession0 opt+ _ <- initSession0 opt getExposedModules <$> getSessionDynFlags where getExposedModules = map moduleNameString
elisp/ghc-command.el view
@@ -41,7 +41,7 @@ (defun ghc-save-buffer () (interactive) (if (buffer-modified-p)- (save-buffer)+ (call-interactively 'save-buffer) (flymake-start-syntax-check))) (provide 'ghc-command)
elisp/ghc-comp.el view
@@ -95,7 +95,7 @@ ;;; (defun ghc-boot (n)- (if (not (ghc-which ghc-module-command))+ (if (not (executable-find ghc-module-command)) (message "%s not found" ghc-module-command) (ghc-read-lisp-list (lambda ()@@ -105,7 +105,7 @@ n))) (defun ghc-load-modules (mods)- (if (not (ghc-which ghc-module-command))+ (if (not (executable-find ghc-module-command)) (message "%s not found" ghc-module-command) (ghc-read-lisp-list (lambda ()
elisp/ghc-func.el view
@@ -49,17 +49,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun ghc-which (cmd)- (catch 'loop- (dolist (suffix '("" ".exe"))- (let ((cmds (concat cmd suffix)))- (dolist (dir exec-path)- (let ((path (expand-file-name cmds dir)))- (if (file-exists-p path)- (throw 'loop path))))))))--;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;- (defun ghc-uniq-lol (lol) (let ((hash (make-hash-table :test 'equal)) ret)
elisp/ghc-indent.el view
@@ -12,24 +12,10 @@ (defun ghc-make-indent-shallower (beg end) (interactive "r")- (let ((n ghc-indent-offset))- (save-excursion- (save-restriction- (narrow-to-region beg end)- (goto-char beg)- (while (not (eobp))- (delete-region (point) (+ (point) n))- (forward-line))))))+ (indent-rigidly (region-beginning) (region-end) (- ghc-indent-offset))) (defun ghc-make-indent-deeper (beg end) (interactive "r")- (let ((indent (make-string ghc-indent-offset 32)))- (save-excursion- (save-restriction- (narrow-to-region beg end)- (goto-char beg)- (while (not (eobp))- (insert indent)- (forward-line))))))+ (indent-rigidly (region-beginning) (region-end) ghc-indent-offset)) (provide 'ghc-indent)
elisp/ghc-info.el view
@@ -70,7 +70,7 @@ (defun ghc-show-type () (interactive)- (if (not (ghc-which ghc-module-command))+ (if (not (executable-find ghc-module-command)) (message "%s not found" ghc-module-command) (let ((modname (or (ghc-find-module-name) "Main"))) (ghc-show-type0 modname))))@@ -134,7 +134,7 @@ (defun ghc-display-information (cmds fontify) (interactive)- (if (not (ghc-which ghc-module-command))+ (if (not (executable-find ghc-module-command)) (message "%s not found" ghc-module-command) (ghc-display fontify
elisp/ghc-ins-mod.el view
@@ -12,7 +12,7 @@ (defun ghc-insert-module () (interactive)- (if (not (ghc-which ghc-hoogle-command))+ (if (not (executable-find ghc-hoogle-command)) (message "\"%s\" not found" ghc-hoogle-command) (let* ((expr0 (ghc-things-at-point)) (expr (ghc-read-expression expr0)))
ghc-mod.cabal view
@@ -1,5 +1,5 @@ Name: ghc-mod-Version: 1.11.0+Version: 1.11.1 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -42,12 +42,10 @@ List Paths_ghc_mod Types- if impl(ghc >= 6.12)- GHC-Options: -Wall -fno-warn-unused-do-bind- else- GHC-Options: -Wall+ GHC-Options: -Wall Build-Depends: base >= 4.0 && < 5 , Cabal+ , convertible , directory , filepath , ghc@@ -59,6 +57,7 @@ , process , regex-posix , syb+ , time , transformers Source-Repository head