packages feed

ghc-mod 1.12.3 → 1.12.4

raw patch · 19 files changed

+179/−69 lines, 19 files

Files

ChangeLog view
@@ -1,6 +1,14 @@-2013-0X-XX v1.12.3+2013-04-02 v1.12.4 +	* C-M-d on Emacs now can browse functions and types.+	* Checking "QuasiQuotes" as well ass "TemplateHaskell". (@eagletmt)+	* "ghc-mod info" can display info of non-exported functions.+	  (@mvoidex)++2013-03-16 v1.12.3+ 	* "ghc-mod info" and "ghc-mod type" also check Template Haskell.+	  (@eagletmt)  2013-03-13 v1.12.2
Cradle.hs view
@@ -38,7 +38,7 @@           , cradlePackageConf = Nothing           }         Just (cdir,cfile) -> do-            let sbox = cdir </> "cabal-dev/"+            let sbox = cdir </> "cabal-dev"                 pkgConf = packageConfName sbox strver             exist <- doesDirectoryExist pkgConf             return Cradle {
Debug.hs view
@@ -25,8 +25,7 @@     [fast] <- withGHC fileName $ do         void $ initializeFlagsWithCradle opt cradle gopts True         setTargetFile fileName-        slow <- needsTemplateHaskell <$> depanal [] False-        return [not slow]+        pure . canCheckFast <$> depanal [] False     return [         "GHC version:         " ++ ver       , "Current directory:   " ++ currentDir
GHCApi.hs view
@@ -5,7 +5,9 @@   , initializeFlagsWithCradle   , setTargetFile   , getDynamicFlags+  , setSlowDynFlags   , checkSlowAndSet+  , canCheckFast   ) where  import CabalApi@@ -44,25 +46,28 @@ importDirs :: [IncludeDir] importDirs = [".","..","../..","../../..","../../../..","../../../../.."] +data Build = CabalPkg | SingleFile deriving Eq+ initializeFlagsWithCradle :: Options -> Cradle -> [GHCOption] -> Bool -> Ghc LogReader initializeFlagsWithCradle opt cradle ghcOptions logging   | cabal     = do       (gopts,idirs,depPkgs) <- liftIO $ fromCabalFile ghcOptions cradle-      initSession opt gopts idirs (Just depPkgs) logging+      initSession CabalPkg opt gopts idirs (Just depPkgs) logging   | otherwise =-      initSession opt ghcOptions importDirs Nothing logging+      initSession SingleFile opt ghcOptions importDirs Nothing logging   where     cabal = isJust $ cradleCabalFile cradle  ---------------------------------------------------------------- -initSession :: Options+initSession :: Build+            -> Options             -> [GHCOption]             -> [IncludeDir]             -> Maybe [Package]             -> Bool             -> Ghc LogReader-initSession opt cmdOpts idirs mDepPkgs logging = do+initSession build opt cmdOpts idirs mDepPkgs logging = do     dflags0 <- getSessionDynFlags     (dflags1,readLog) <- setupDynamicFlags dflags0     _ <- setSessionDynFlags dflags1@@ -70,8 +75,7 @@   where     setupDynamicFlags df0 = do         df1 <- modifyFlagsWithOpts df0 cmdOpts-        let fast = True-        let df2 = modifyFlags df1 idirs mDepPkgs fast (expandSplice opt)+        let df2 = modifyFlags df1 idirs mDepPkgs (expandSplice opt) build         df3 <- modifyFlagsWithOpts df2 $ ghcOpts opt         liftIO $ setLogger logging df3 @@ -86,15 +90,20 @@ ----------------------------------------------------------------  -- FIXME removing Options-modifyFlags :: DynFlags -> [IncludeDir] -> Maybe [Package] -> Bool -> Bool -> DynFlags-modifyFlags d0 idirs mDepPkgs fast splice-  | splice    = setSplice d3-  | otherwise = d3+modifyFlags :: DynFlags -> [IncludeDir] -> Maybe [Package] -> Bool -> Build -> DynFlags+modifyFlags d0 idirs mDepPkgs splice build+  | splice    = setSplice d4+  | otherwise = d4   where     d1 = d0 { importPaths = idirs }-    d2 = setFastOrNot d1 fast+    d2 = setFastOrNot d1 Fast     d3 = maybe d2 (addDevPkgs d2) mDepPkgs+    d4 | build == CabalPkg = setCabalPkg d3+       | otherwise         = d3 +setCabalPkg :: DynFlags -> DynFlags+setCabalPkg dflag = dopt_set dflag Opt_BuildingCabalPackage+ setSplice :: DynFlags -> DynFlags setSplice dflag = dopt_set dflag Opt_D_dump_splices @@ -108,18 +117,18 @@  ---------------------------------------------------------------- -setFastOrNot :: DynFlags -> Bool -> DynFlags-setFastOrNot dflags False = dflags {+setFastOrNot :: DynFlags -> CheckSpeed -> DynFlags+setFastOrNot dflags Slow = dflags {     ghcLink   = LinkInMemory   , hscTarget = HscInterpreted   }-setFastOrNot dflags True = dflags {+setFastOrNot dflags Fast = dflags {     ghcLink   = NoLink   , hscTarget = HscNothing   }  setSlowDynFlags :: Ghc ()-setSlowDynFlags = (flip setFastOrNot False <$> getSessionDynFlags)+setSlowDynFlags = (flip setFastOrNot Slow <$> getSessionDynFlags)                   >>= void . setSessionDynFlags  -- To check TH, a session module graph is necessary.@@ -128,8 +137,8 @@ -- So, this is necessary redundancy. checkSlowAndSet :: Ghc () checkSlowAndSet = do-    slow <- needsTemplateHaskell <$> depanal [] False-    when slow setSlowDynFlags+    fast <- canCheckFast <$> depanal [] False+    unless fast setSlowDynFlags  ---------------------------------------------------------------- @@ -150,3 +159,9 @@  getDynamicFlags :: IO DynFlags getDynamicFlags = runGhc (Just libdir) getSessionDynFlags++canCheckFast :: ModuleGraph -> Bool+canCheckFast = not . any (hasTHorQQ . ms_hspp_opts)+  where+    hasTHorQQ :: DynFlags -> Bool+    hasTHorQQ dflags = any (\opt -> xopt opt dflags) [Opt_TemplateHaskell, Opt_QuasiQuotes]
GHCMod.hs view
@@ -21,7 +21,7 @@ import System.Console.GetOpt import System.Directory import System.Environment (getArgs)-import System.IO (hPutStr, hPutStrLn, stderr)+import System.IO (hPutStr, hPutStrLn, stdout, stderr, hSetEncoding, utf8) import Types  ----------------------------------------------------------------@@ -87,6 +87,9 @@  main :: IO () main = flip catches handlers $ do+-- #if __GLASGOW_HASKELL__ >= 611+    hSetEncoding stdout utf8+-- #endif     args <- getArgs     let (opt',cmdArg) = parseArgs argspec args     (strVer,ver) <- getGHCVersion
Info.hs view
@@ -4,7 +4,7 @@ module Info (infoExpr, typeExpr) where  import Control.Applicative-import Control.Monad (void)+import Control.Monad (void, when) import CoreUtils import Data.Function import Data.Generics@@ -32,14 +32,16 @@ type Expression = String type ModuleString = String +data Cmd = Info | Type deriving Eq+ ----------------------------------------------------------------  infoExpr :: Options -> Cradle -> ModuleString -> Expression -> FilePath -> IO String infoExpr opt cradle modstr expr file = (++ "\n") <$> info opt cradle file modstr expr -info :: Options -> Cradle -> FilePath -> ModuleString -> FilePath -> IO String+info :: Options -> Cradle -> FilePath -> ModuleString -> Expression -> IO String info opt cradle fileName modstr expr =-    inModuleContext opt cradle fileName modstr exprToInfo "Cannot show info"+    inModuleContext Info opt cradle fileName modstr exprToInfo "Cannot show info"   where     exprToInfo = infoThing expr @@ -70,7 +72,7 @@  typeOf :: Options -> Cradle -> FilePath -> ModuleString -> Int -> Int -> IO String typeOf opt cradle fileName modstr lineNo colNo =-    inModuleContext opt cradle fileName modstr exprToType errmsg+    inModuleContext Type opt cradle fileName modstr exprToType errmsg   where     exprToType = do       modSum <- getModSummary $ mkModuleName modstr@@ -139,12 +141,13 @@  ---------------------------------------------------------------- -inModuleContext :: Options -> Cradle -> FilePath -> ModuleString -> Ghc String -> String -> IO String-inModuleContext opt cradle fileName modstr action errmsg =+inModuleContext :: Cmd -> Options -> Cradle -> FilePath -> ModuleString -> Ghc String -> String -> IO String+inModuleContext cmd opt cradle fileName modstr action errmsg =     withGHCDummyFile (valid ||> invalid ||> return errmsg)   where     valid = do         void $ initializeFlagsWithCradle opt cradle ["-w:"] False+        when (cmd == Info) setSlowDynFlags         setTargetFile fileName         checkSlowAndSet         void $ load LoadAllTargets
Types.hs view
@@ -76,3 +76,5 @@ type GHCOption  = String type IncludeDir = FilePath type Package    = String++data CheckSpeed = Slow | Fast
elisp/ghc-doc.el view
@@ -8,17 +8,28 @@  (require 'ghc-func) (require 'ghc-comp)+(require 'ghc-info)  ;;; Code:  (defun ghc-browse-document (&optional haskell-org)   (interactive "P")-  (let* ((mod0 (ghc-extract-module))-	 (mod (ghc-read-module-name mod0))-	 (pkg (ghc-resolve-package-name mod)))-    (if (and pkg mod)-	(ghc-display-document pkg mod haskell-org)-      (message "No document found"))))+  (let ((mod0 (ghc-extract-module))+	(expr (ghc-things-at-point)))+    (cond+     ((and (not mod0) expr)+      (let* ((info (ghc-get-info expr))+	     (mod (ghc-extact-module-from-info info))+	     (pkg (ghc-resolve-package-name mod)))+	(if (and pkg mod)+	    (ghc-display-document pkg mod haskell-org expr)+	  (message "No document found"))))+     (t+      (let* ((mod (ghc-read-module-name mod0))+	     (pkg (ghc-resolve-package-name mod)))+	(if (and pkg mod)+	    (ghc-display-document pkg mod haskell-org)+	  (message "No document found")))))))  (defun ghc-resolve-package-name (mod)   (with-temp-buffer@@ -44,7 +55,7 @@  (ghc-defstruct pkg-ver pkg ver) -(defun ghc-display-document (pkg-ver mod haskell-org)+(defun ghc-display-document (pkg-ver mod haskell-org &optional symbol)   (when (and pkg-ver mod)     (let* ((mod- (ghc-replace-character mod ?. ?-)) 	   (pkg (ghc-pkg-ver-get-pkg pkg-ver))@@ -54,8 +65,31 @@ 	   (local (format ghc-doc-local-format path mod-)) 	   (remote (format ghc-doc-hackage-format pkg ver mod-)) 	   (file (format "%s/%s.html" path mod-))-           (url (if (or haskell-org (not (file-exists-p file))) remote local)))+           (url0 (if (or haskell-org (not (file-exists-p file))) remote local))+	   (url (if symbol (ghc-add-anchor url0 symbol) url0)))+      ;; Mac's "open" removes the anchor from "file://", sigh.       (browse-url url))))++(defun ghc-add-anchor (url symbol)+  (let ((case-fold-search nil))+    (if (string-match "^[A-Z]" symbol)+	(concat url "#t:" symbol)+      (if (string-match "^[a-z]" symbol)+	  (concat url "#v:" symbol)+	(concat url "#v:" (ghc-url-encode symbol))))))++(defun ghc-url-encode (symbol)+  (let ((len (length symbol))+	(i 0)+	acc)+    (while (< i len)+      (setq acc (cons (format "-%d-" (aref symbol i)) acc))+      (setq i (1+ i)))+    (apply 'concat (nreverse acc))))++(defun ghc-extact-module-from-info (info)+  (when (string-match "\`\\([^']+\\)'" info)+    (match-string 1 info)))  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
elisp/ghc-flymake.el view
@@ -78,7 +78,7 @@ 	  (errs (ghc-flymake-err-list)))       (ghc-display        nil-       (lambda (&rest ignore)+       (lambda () 	 (insert title "\n\n") 	 (mapc (lambda (x) (insert x "\n")) errs))))))
elisp/ghc-func.el view
@@ -147,11 +147,10 @@ (defconst ghc-error-buffer-name "*GHC Info*")  (defun ghc-display (fontify ins-func)-  (let ((cdir default-directory)-	(buf (get-buffer-create ghc-error-buffer-name)))+  (let ((buf (get-buffer-create ghc-error-buffer-name)))     (with-current-buffer buf       (erase-buffer)-      (funcall ins-func cdir)+      (funcall ins-func)       (ghc-replace-character-buffer ghc-null ghc-newline)       (goto-char (point-min))       (if (not fontify)@@ -159,5 +158,20 @@ 	(haskell-font-lock-defaults-create) 	(turn-on-haskell-font-lock)))     (display-buffer buf)))++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;++(defun ghc-run-ghc-mod (cmds)+  (cond+   ((executable-find ghc-module-command)+    (let ((cdir default-directory))+      (with-temp-buffer+	(cd cdir)+	(apply 'call-process ghc-module-command nil t nil+	       (append (ghc-make-ghc-options) cmds))+	(buffer-substring (point-min) (1- (point-max))))))+   (t+    (message "%s not found" ghc-module-command)+    nil)))  (provide 'ghc-func)
elisp/ghc-info.el view
@@ -12,12 +12,19 @@  (defun ghc-show-info (&optional ask)   (interactive "P")-  (let* ((modname (or (ghc-find-module-name) "Main"))-	 (expr0 (ghc-things-at-point))+  (let* ((expr0 (ghc-things-at-point)) 	 (expr (if (or ask (not expr0)) (ghc-read-expression expr0) expr0))+	 (info (ghc-get-info expr)))+    (when info+      (ghc-display+       nil+       (lambda () (insert info))))))++(defun ghc-get-info (expr)+  (let* ((modname (or (ghc-find-module-name) "Main")) 	 (file (buffer-file-name)) 	 (cmds (list "info" file modname expr)))-    (ghc-display-information cmds nil)))+    (ghc-run-ghc-mod cmds)))  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;@@ -124,27 +131,12 @@ (defun ghc-expand-th ()   (interactive)   (let* ((file (buffer-file-name))-	 (cmds (list "expand" file)))-    (ghc-display-information cmds t)))--;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;-;;;-;;; Display-;;;--(defun ghc-display-information (cmds fontify)-  (interactive)-  (if (not (executable-find ghc-module-command))-      (message "%s not found" ghc-module-command)-    (ghc-display-     fontify-     (lambda (cdir)-       (insert-	(with-temp-buffer-	  (cd cdir)-	  (apply 'call-process ghc-module-command nil t nil-		 (append (ghc-make-ghc-options) cmds))-	  (buffer-substring (point-min) (1- (point-max)))))))))+	 (cmds (list "expand" file))+	 (source (ghc-run-ghc-mod cmds)))+    (when source+      (ghc-display+       'fontify+       (lambda () (insert source))))))  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;
ghc-mod.cabal view
@@ -1,5 +1,5 @@ Name:                   ghc-mod-Version:                1.12.3+Version:                1.12.4 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3
test/CheckSpec.hs view
@@ -3,10 +3,11 @@ import CabalApi import Check import Cradle-import Data.List (isSuffixOf, isInfixOf)+import Data.List (isSuffixOf, isInfixOf, isPrefixOf) import Expectation import Test.Hspec import Types+import System.FilePath  spec :: Spec spec = do@@ -22,7 +23,7 @@             withDirectory_ "test/data/check-test-subdir" $ do                 cradle <- getGHCVersion >>= findCradle Nothing . fst                 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`)+                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@@ -30,4 +31,9 @@                 cradle <- findCradle Nothing strVer                 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+                res <- checkSyntax defaultOptions cradle "Baz.hs"+                res `shouldSatisfy` ("Baz.hs:5:1:Warning:" `isPrefixOf`)
test/DebugSpec.hs view
@@ -21,3 +21,6 @@             checkFast "Main.hs" "Fast check:          No"             checkFast "Foo.hs"  "Fast check:          Yes"             checkFast "Bar.hs"  "Fast check:          No"++        it "can check QuasiQuotes" $ do+            checkFast "Baz.hs"  "Fast check:          No"
test/InfoSpec.hs view
@@ -7,6 +7,8 @@ import Info import Test.Hspec import Types+import System.Process+import System.Exit  spec :: Spec spec = do@@ -31,6 +33,12 @@                 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+                res <- infoExpr defaultOptions cradle "Info" "fib" "Info.hs"+                res `shouldSatisfy` ("fib :: Int -> Int" `isPrefixOf`)+         it "works with a module using TemplateHaskell" $ do             withDirectory_ "test/data" $ do                 cradle <- getGHCVersion >>= findCradle Nothing . fst@@ -42,3 +50,7 @@                 cradle <- getGHCVersion >>= findCradle Nothing . fst                 res <- infoExpr defaultOptions cradle "Main" "bar" "Main.hs"                 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"]+            code `shouldSatisfy` (== ExitSuccess)
+ test/data/Baz.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE QuasiQuotes #-}+module Baz (baz) where+import Foo (fooQ)++baz = [fooQ| foo bar baz |]
test/data/Foo.hs view
@@ -1,5 +1,9 @@-module Foo (foo) where+module Foo (foo, fooQ) where import Language.Haskell.TH+import Language.Haskell.TH.Quote (QuasiQuoter(..))  foo :: ExpQ foo = stringE "foo"++fooQ :: QuasiQuoter+fooQ = QuasiQuoter (litE . stringL) undefined undefined undefined
+ test/data/Info.hs view
@@ -0,0 +1,6 @@+module Info () where++fib :: Int -> Int+fib 0 = 0+fib 1 = 1+fib n = fib (n - 1) + fib (n - 2)
+ test/data/Unicode.hs view
@@ -0,0 +1,4 @@+module Unicode where++unicode :: α -> α+unicode = id