ghc-mod-3.1.4/0000755000000000000000000000000012243047510011221 5ustar0000000000000000ghc-mod-3.1.4/ChangeLog0000644000000000000000000000476112243047510013003 0ustar00000000000000002013-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". 2013-09-16 v3.0.1 * Exporting more low level APIs. * Adding "-ibuild/autogen" * Adding "-optP". (Macros from a Cabal file and "dist/build/autogen/cabal_macros.h") 2013-09-06 v3.0.0 * Supporting the sandbox of cabal 1.18. * Obsoleting the support for cabal-dev. 2013-09-04 v2.1.2 * Supporting multiple target files. (@nh2) 2013-09-03 v2.1.1 * A bug fix for library dependency. 2013-09-03 v2.1.0 * Exporting Language.Haskell.GhcMod.Internal. (@alanz) * Supporting GHC 7.7. (@co-dan) 2013-05-30 v2.0.3 * Using finalizePackageDescription to enable "if else" in a cabal file. 2013-05-21 v2.0.2 * Document fixes. 2013-05-21 v2.0.1 * Document fixes. 2013-05-21 v2.0.0 * ghc-mod also provides a library (Language.Haskell.GhcMod) 2013-05-13 v1.12.5 * A bug fix for the case where a cabal file is broken. 2013-04-02 v1.12.4 * C-M-d on Emacs now can browse functions and types. * Checking "QuasiQuotes" as well as "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 * New logic to set "-fno-code" using "depanal" * Cleaning up the code relating to Doc/SDoc 2013-03-07 v1.12.1 * Fixing a bug to find a sandbox. 2013-03-05 v1.12.0 * "ghc-mod debug" to see which cabal file and sand box are used * Fast "ghc-mod check" if Template Haskell is not used * "ghc-mod brwose -d" displays more information (@eagletmt) 2013-03-01 v1.11.5 * New option "-d" for "ghc-mod browse" to show symbols with type info (@moidex) 2013-02-15 v1.11.4 * Adding Hspec test suite * Better way to show Extension (@eagletmt) * Removing the library itself from Cabal dependencies 2012-12-11 v1.11.3 * Display a filname instead of "Dummy" if an error occur 2012-10-30 v1.11.2 * Extract dependencies from a Cabal file if exists and specify them to "ghc-mod check" (@khibino) 2012-10-19 v1.11.1 * Supporting GHC 7.6.x (@cartazio, @dysinger, @ihameed) ghc-mod-3.1.4/ghc-mod.cabal0000644000000000000000000001307112243047510013525 0ustar0000000000000000Name: ghc-mod Version: 3.1.4 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 License-File: LICENSE Homepage: http://www.mew.org/~kazu/proj/ghc-mod/ Synopsis: Happy Haskell Programming Description: The ghc-mod command is a backend command to enrich Haskell programming on editors including Emacs, Vim, and Sublime. The ghc-mod command is based on ghc-mod library which is a wrapper of GHC API. This package includes the ghc-mod command, the ghc-mod library, and Emacs front-end (for historical reasons). For more information, please see its home page. Category: Development Cabal-Version: >= 1.10 Build-Type: Simple Data-Dir: elisp Data-Files: Makefile ghc.el ghc-func.el ghc-doc.el ghc-comp.el ghc-flymake.el ghc-command.el ghc-info.el ghc-ins-mod.el ghc-indent.el ghc-pkg.el Extra-Source-Files: ChangeLog test/data/*.cabal test/data/*.hs test/data/cabal.sandbox.config test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/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/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 GHC-Options: -Wall Exposed-Modules: Language.Haskell.GhcMod Language.Haskell.GhcMod.Internal Other-Modules: Language.Haskell.GhcMod.Browse Language.Haskell.GhcMod.CabalApi Language.Haskell.GhcMod.Check Language.Haskell.GhcMod.Cradle Language.Haskell.GhcMod.Doc Language.Haskell.GhcMod.Debug Language.Haskell.GhcMod.ErrMsg Language.Haskell.GhcMod.Flag Language.Haskell.GhcMod.GHCApi Language.Haskell.GhcMod.GHCChoice Language.Haskell.GhcMod.Gap Language.Haskell.GhcMod.Info Language.Haskell.GhcMod.Lang Language.Haskell.GhcMod.Lint Language.Haskell.GhcMod.List Language.Haskell.GhcMod.Types Build-Depends: base >= 4.0 && < 5 , Cabal >= 1.10 , containers , directory , filepath , ghc , ghc-paths , ghc-syb-utils , hlint >= 1.7.1 , io-choice , old-time , process , syb , time , transformers if impl(ghc < 7.7) Build-Depends: convertible Executable ghc-mod Default-Language: Haskell2010 Main-Is: GHCMod.hs Other-Modules: Paths_ghc_mod GHC-Options: -Wall HS-Source-Dirs: src Build-Depends: base >= 4.0 && < 5 , directory , filepath , 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 Hs-Source-Dirs: test, . Type: exitcode-stdio-1.0 Other-Modules: Dir BrowseSpec CabalApiSpec CheckSpec DebugSpec FlagSpec InfoSpec LangSpec LintSpec ListSpec Build-Depends: base >= 4.0 && < 5 , Cabal >= 1.10 , containers , directory , filepath , ghc , ghc-paths , ghc-syb-utils , hlint >= 1.7.1 , io-choice , old-time , process , syb , 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 Location: git://github.com/kazu-yamamoto/ghc-mod.git ghc-mod-3.1.4/LICENSE0000644000000000000000000000276512243047510012240 0ustar0000000000000000Copyright (c) 2009, IIJ Innovation Institute Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ghc-mod-3.1.4/Setup.hs0000644000000000000000000000005612243047510012656 0ustar0000000000000000import Distribution.Simple main = defaultMain ghc-mod-3.1.4/elisp/0000755000000000000000000000000012243047510012335 5ustar0000000000000000ghc-mod-3.1.4/elisp/ghc-command.el0000644000000000000000000000212712243047510015036 0ustar0000000000000000;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ghc-command.el ;;; ;; Author: Kazu Yamamoto ;; Created: Apr 13, 2010 ;;; Code: (require 'ghc-flymake) (defun ghc-insert-template () (interactive) (cond ((bobp) (ghc-insert-module-template)) ((ghc-flymake-have-errs-p) (ghc-flymake-insert-from-warning)) (t (message "Nothing to be done")))) (defun ghc-insert-module-template () (let ((mod (file-name-sans-extension (buffer-name)))) (aset mod 0 (upcase (aref mod 0))) (insert "module " mod " where\n"))) (defun ghc-sort-lines (beg end) (interactive "r") (save-excursion (save-restriction (narrow-to-region beg end) (goto-char (point-min)) (let ((inhibit-field-text-motion t)) (sort-subr nil 'forward-line 'end-of-line (lambda () (re-search-forward "^import\\( *qualified\\)? *" nil t) nil) 'end-of-line))))) (defun ghc-save-buffer () (interactive) (if (buffer-modified-p) (call-interactively 'save-buffer) (flymake-start-syntax-check))) (provide 'ghc-command) ghc-mod-3.1.4/elisp/ghc-comp.el0000644000000000000000000002100612243047510014353 0ustar0000000000000000;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ghc-comp.el ;;; ;; Author: Kazu Yamamoto ;; Created: Sep 25, 2009 ;;; Code: (require 'ghc-func) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Customize Variables ;;; (defvar ghc-idle-timer-interval 30 "*Period of idele timer in second. When timeout, the names of unloaded modules are loaded") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Constants ;;; ;; must be sorted (defconst ghc-reserved-keyword-for-bol '("class" "data" "default" "import" "infix" "infixl" "infixr" "instance" "main" "module" "newtype" "type")) ;; must be sorted (defconst ghc-reserved-keyword '("case" "deriving" "do" "else" "if" "in" "let" "module" "of" "then" "where")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Local Variables ;;; (defvar ghc-window-configuration nil) (mapc 'make-variable-buffer-local '(ghc-window-configuration)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Initializer ;;; (defvar ghc-module-names nil) ;; completion for "import" (defvar ghc-merged-keyword nil) ;; completion for type/func/... (defvar ghc-language-extensions nil) (defvar ghc-option-flags nil) (defvar ghc-pragma-names '("LANGUAGE" "OPTIONS_GHC")) (defconst ghc-keyword-prefix "ghc-keyword-") (defvar ghc-keyword-Prelude nil) (defvar ghc-keyword-Control.Applicative nil) (defvar ghc-keyword-Control.Monad nil) (defvar ghc-keyword-Control.Exception nil) (defvar ghc-keyword-Data.Char nil) (defvar ghc-keyword-Data.List nil) (defvar ghc-keyword-Data.Maybe nil) (defvar ghc-keyword-System.IO nil) (defvar ghc-loaded-module nil) (defun ghc-comp-init () (add-hook 'find-file-hook 'ghc-import-module) (let* ((syms '(ghc-module-names ghc-language-extensions ghc-option-flags ghc-keyword-Prelude ghc-keyword-Control.Applicative ghc-keyword-Control.Monad ghc-keyword-Control.Exception ghc-keyword-Data.Char ghc-keyword-Data.List ghc-keyword-Data.Maybe ghc-keyword-System.IO)) (vals (ghc-boot (length syms)))) (ghc-set syms vals)) (ghc-add ghc-module-names "qualified") (ghc-add ghc-module-names "hiding") (ghc-merge-keywords '("Prelude" "Control.Applicative" "Control.Monad" "Control.Exception" "Data.Char" "Data.List" "Data.Maybe" "System.IO")) (run-with-idle-timer ghc-idle-timer-interval 'repeat 'ghc-idle-timer)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Executing command ;;; (defun ghc-boot (n) (if (not (executable-find ghc-module-command)) (message "%s not found" ghc-module-command) (ghc-read-lisp-list (lambda () (message "Initializing...") (call-process ghc-module-command nil t nil "-l" "boot") (message "Initializing...done")) n))) (defun ghc-load-modules (mods) (if (not (executable-find ghc-module-command)) (message "%s not found" ghc-module-command) (ghc-read-lisp-list (lambda () (message "Loading names...") (apply 'call-process ghc-module-command nil '(t nil) nil `(,@(ghc-make-ghc-options) "-l" "browse" ,@mods)) (message "Loading names...done")) (length mods)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Completion ;;; (defvar ghc-completion-buffer-name "*Completions*") (defun ghc-complete () (interactive) (if (ghc-should-scroll) (ghc-scroll-completion-buffer) (ghc-try-complete))) (defun ghc-should-scroll () (let ((window (ghc-completion-window))) (and (eq last-command this-command) window (window-live-p window) (window-buffer window) (buffer-name (window-buffer window))))) (defun ghc-scroll-completion-buffer () (let ((window (ghc-completion-window))) (with-current-buffer (window-buffer window) (if (pos-visible-in-window-p (point-max) window) (set-window-start window (point-min)) (save-selected-window (select-window window) (scroll-up)))))) (defun ghc-completion-window () (get-buffer-window ghc-completion-buffer-name 0)) (defun ghc-try-complete () (let* ((end (point)) (symbols (ghc-select-completion-symbol)) (beg (ghc-completion-start-point)) (pattern (buffer-substring-no-properties beg end)) (completion (try-completion pattern symbols))) (cond ((eq completion t) ;; completed ) ;; do nothing ((null completion) ;; no completions (ding)) ((not (string= pattern completion)) ;; ??? (delete-region beg end) (insert completion) (ghc-reset-window-configuration)) (t ;; multiple completions (let* ((list0 (all-completions pattern symbols)) (list (sort list0 'string<))) (if (= (length list) 1) (ghc-reset-window-configuration) (ghc-save-window-configuration) (with-output-to-temp-buffer ghc-completion-buffer-name (display-completion-list list pattern)))))))) (defun ghc-save-window-configuration () (unless (get-buffer-window ghc-completion-buffer-name) (setq ghc-window-configuration (current-window-configuration)))) (defun ghc-reset-window-configuration () (when ghc-window-configuration (set-window-configuration ghc-window-configuration) (setq ghc-window-configuration nil))) (defun ghc-module-completion-p () (or (minibufferp) (let ((end (point))) (save-excursion (beginning-of-line) (and (looking-at "import ") (not (search-forward "(" end t))))) (save-excursion (beginning-of-line) (looking-at " +module ")))) (defun ghc-select-completion-symbol () (cond ((ghc-module-completion-p) ghc-module-names) ((save-excursion (beginning-of-line) (looking-at "{-# LANGUAGE ")) ghc-language-extensions) ((save-excursion (beginning-of-line) (looking-at "{-# OPTIONS_GHC ")) ghc-option-flags) ((save-excursion (beginning-of-line) (looking-at "{-# ")) ghc-pragma-names) ((or (bolp) (let ((end (point))) (save-excursion (beginning-of-line) (not (search-forward " " end t))))) ghc-reserved-keyword-for-bol) (t ghc-merged-keyword))) (defun ghc-completion-start-point () (save-excursion (let ((beg (save-excursion (beginning-of-line) (point))) (regex (if (ghc-module-completion-p) "[ (,`]" "[ (,`.]"))) (if (re-search-backward regex beg t) (1+ (point)) beg)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Loading keywords ;;; (defun ghc-import-module () (interactive) (when (eq major-mode 'haskell-mode) (ghc-load-module-buffer))) (defun ghc-unloaded-modules (mods) (ghc-filter (lambda (mod) (and (member mod ghc-module-names) (not (member mod ghc-loaded-module)))) mods)) (defun ghc-load-module-all-buffers () (ghc-load-merge-modules (ghc-gather-import-modules-all-buffers))) (defun ghc-load-module-buffer () (ghc-load-merge-modules (ghc-gather-import-modules-buffer))) (defun ghc-load-merge-modules (mods) (let* ((umods (ghc-unloaded-modules mods)) (syms (mapcar 'ghc-module-symbol umods)) (names (ghc-load-modules umods))) (ghc-set syms names) (ghc-merge-keywords umods))) (defun ghc-merge-keywords (mods) (setq ghc-loaded-module (append mods ghc-loaded-module)) (let* ((modkeys (mapcar 'ghc-module-keyword ghc-loaded-module)) (keywords (cons ghc-reserved-keyword modkeys)) (uniq-sorted (sort (ghc-uniq-lol keywords) 'string<))) (setq ghc-merged-keyword uniq-sorted))) (defun ghc-module-symbol (mod) (intern (concat ghc-keyword-prefix mod))) (defun ghc-module-keyword (mod) (symbol-value (ghc-module-symbol mod))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (ghc-defstruct buffer name file) (defun ghc-buffer-name-file (buf) (ghc-make-buffer (buffer-name buf) (buffer-file-name buf))) (defun ghc-gather-import-modules-all-buffers () (let ((bufs (mapcar 'ghc-buffer-name-file (buffer-list))) ret file) (save-excursion (dolist (buf bufs (ghc-uniq-lol ret)) (setq file (ghc-buffer-get-file buf)) (when (and file (string-match "\\.hs$" file)) (set-buffer (ghc-buffer-get-name buf)) (ghc-add ret (ghc-gather-import-modules-buffer))))))) (defun ghc-gather-import-modules-buffer () (let (ret) (save-excursion (goto-char (point-min)) (while (re-search-forward "^import\\( *qualified\\)? +\\([^\n ]+\\)" nil t) (ghc-add ret (match-string-no-properties 2)) (forward-line))) ret)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Background Idle Timer ;;; (defalias 'ghc-idle-timer 'ghc-load-module-all-buffer) (defun ghc-load-module-all-buffer () nil) (provide 'ghc-comp) ghc-mod-3.1.4/elisp/ghc-doc.el0000644000000000000000000000731212243047510014166 0ustar0000000000000000;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ghc.el ;;; ;; Author: Kazu Yamamoto ;; Created: Sep 25, 2009 (require 'ghc-func) (require 'ghc-comp) (require 'ghc-info) ;;; Code: (defun ghc-browse-document (&optional haskell-org) (interactive "P") (let ((mod0 (ghc-extract-module)) (expr0 (ghc-things-at-point))) (cond ((and (not mod0) expr0) (let* ((expr (ghc-read-expression expr0)) (info (ghc-get-info expr0)) (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 (call-process "ghc-pkg" nil t nil "find-module" "--simple-output" mod) (goto-char (point-min)) (when (re-search-forward "\\([^ ]+\\)-\\([0-9]*\\(\\.[0-9]+\\)*\\)$" nil t) (ghc-make-pkg-ver :pkg (match-string-no-properties 1) :ver (match-string-no-properties 2))))) (defun ghc-resolve-document-path (pkg) (with-temp-buffer (call-process "ghc-pkg" nil t nil "field" pkg "haddock-html") (goto-char (point-max)) (forward-line -1) (beginning-of-line) (when (looking-at "^haddock-html: \\([^ \n]+\\)$") (match-string-no-properties 1)))) (defconst ghc-doc-local-format "file://%s/%s.html") (defconst ghc-doc-hackage-format "http://hackage.haskell.org/packages/archive/%s/%s/doc/html/%s.html") (ghc-defstruct pkg-ver pkg ver) (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)) (ver (ghc-pkg-ver-get-ver pkg-ver)) (pkg-with-ver (format "%s-%s" pkg ver)) (path (ghc-resolve-document-path pkg-with-ver)) (local (format ghc-doc-local-format path mod-)) (remote (format ghc-doc-hackage-format pkg ver mod-)) (file (format "%s/%s.html" path mod-)) (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))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar ghc-input-map nil) (unless ghc-input-map (setq ghc-input-map (if (boundp 'minibuffer-local-map) (copy-keymap minibuffer-local-map) (make-sparse-keymap))) (define-key ghc-input-map "\t" 'ghc-complete)) (defun ghc-read-module-name (def) (read-from-minibuffer "Module name: " def ghc-input-map)) (defun ghc-read-expression (def) (read-from-minibuffer "Expression: " def ghc-input-map)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ghc-extract-module () (interactive) (save-excursion (beginning-of-line) (if (looking-at "^\\(import\\|module\\) +\\(qualified +\\)?\\([^ (\n]+\\)") (match-string-no-properties 3)))) (provide 'ghc-doc) ghc-mod-3.1.4/elisp/ghc-flymake.el0000644000000000000000000001455312243047510015056 0ustar0000000000000000;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ghc-flymake.el ;;; ;; Author: Kazu Yamamoto ;; Created: Mar 12, 2010 ;;; Code: (require 'flymake) (require 'ghc-func) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar ghc-hlint-options nil "*Hlint options") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst ghc-flymake-allowed-file-name-masks '("\\.l?hs$" ghc-flymake-init nil ghc-emacs23-larter-hack)) (defconst ghc-flymake-err-line-patterns '("^\\(.*\\):\\([0-9]+\\):\\([0-9]+\\):[ ]*\\(.+\\)" 1 2 3 4)) (add-to-list 'flymake-allowed-file-name-masks ghc-flymake-allowed-file-name-masks) (add-to-list 'flymake-err-line-patterns ghc-flymake-err-line-patterns) ;; flymake of Emacs 23 or later does not display errors ;; if they occurred in other files. So, let's cheat flymake. (defun ghc-emacs23-larter-hack (tmp-file) (let ((real-name (flymake-get-real-file-name tmp-file)) (hack-name (flymake-get-real-file-name source-file-name))) (unless (string= real-name hack-name) ;; Change the local variable, line-err-info, ;; in flymake-parse-err-lines. (setq line-err-info (flymake-ler-make-ler nil 1 (flymake-ler-type line-err-info) (concat real-name ": " (flymake-ler-text line-err-info)) (flymake-ler-full-file line-err-info)))) hack-name)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ghc-flymake-init () (list ghc-module-command (ghc-flymake-command (flymake-init-create-temp-buffer-copy 'flymake-create-temp-inplace)))) (defvar ghc-flymake-command nil) ;; nil: check, t: lint (defun ghc-flymake-command (file) (if ghc-flymake-command (let ((hopts (ghc-mapconcat (lambda (x) (list "-h" x)) ghc-hlint-options))) `(,@hopts "lint" ,file)) `(,@(ghc-make-ghc-options) "check" ,file))) (defun ghc-flymake-toggle-command () (interactive) (setq ghc-flymake-command (not ghc-flymake-command)) (if ghc-flymake-command (message "Syntax check with hlint") (message "Syntax check with GHC"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ghc-flymake-display-errors () (interactive) (if (not (ghc-flymake-have-errs-p)) (message "No errors or warnings") (let ((title (ghc-flymake-err-title)) (errs (ghc-flymake-err-list))) (ghc-display nil (lambda () (insert title "\n\n") (mapc (lambda (x) (insert x "\n")) errs)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ghc-flymake-jump () (interactive) (if (not (ghc-flymake-have-errs-p)) (message "No errors or warnings") (let* ((acts (ghc-flymake-act-list)) (act (car acts))) (if (not act) (message "No destination") (eval act))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ghc-extract-type (str) (with-temp-buffer (insert str) (goto-char (point-min)) (when (re-search-forward "Inferred type: \\|no type signature:\\( \\|\0 +\\)?" nil t) (delete-region (point-min) (point))) (when (re-search-forward " forall [^.]+\\." nil t) (replace-match "")) (while (re-search-forward "\0 +" nil t) (replace-match " ")) (goto-char (point-min)) (while (re-search-forward "\\[Char\\]" nil t) (replace-match "String")) (re-search-forward "\0" nil t) (buffer-substring-no-properties (point-min) (1- (point))))) (defun ghc-flymake-insert-from-warning () (interactive) (dolist (data (ghc-flymake-err-list)) (save-excursion (cond ((string-match "Inferred type: \\|no type signature:" data) (beginning-of-line) (insert (ghc-extract-type data) "\n")) ((string-match "lacks an accompanying binding" data) (beginning-of-line) (when (looking-at "^\\([^ ]+\\) *::") (save-match-data (forward-line) (if (not (bolp)) (insert "\n"))) (insert (match-string 1) " = undefined\n"))) ((string-match "Not in scope: `\\([^']+\\)'" data) (save-match-data (unless (re-search-forward "^$" nil t) (goto-char (point-max)) (insert "\n"))) (insert "\n" (match-string 1 data) " = undefined\n")) ((string-match "Pattern match(es) are non-exhaustive" data) (let* ((fn (ghc-get-function-name)) (arity (ghc-get-function-arity fn))) (ghc-insert-underscore fn arity))) ((string-match "Found:\0[ ]*\\([^\0]+\\)\0Why not:\0[ ]*\\([^\0]+\\)" data) (let ((old (match-string 1 data)) (new (match-string 2 data))) (beginning-of-line) (when (search-forward old nil t) (let ((end (point))) (search-backward old nil t) (delete-region (point) end)) (insert new)))))))) (defun ghc-get-function-name () (save-excursion (beginning-of-line) (when (looking-at "\\([^ ]+\\) ") (match-string 1)))) (defun ghc-get-function-arity (fn) (when fn (save-excursion (let ((regex (format "^%s *::" (regexp-quote fn)))) (when (re-search-backward regex nil t) (ghc-get-function-arity0)))))) (defun ghc-get-function-arity0 () (let ((end (save-excursion (end-of-line) (point))) (arity 0)) (while (search-forward "->" end t) (setq arity (1+ arity))) arity)) (defun ghc-insert-underscore (fn ar) (when fn (let ((arity (or ar 1))) (save-excursion (goto-char (point-max)) (re-search-backward (format "^%s *::" (regexp-quote fn))) (forward-line) (re-search-forward "^$" nil t) (insert fn) (dotimes (i arity) (insert " _")) (insert " = error \"" fn "\""))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ghc-flymake-err-get-title (x) (nth 0 x)) (defun ghc-flymake-err-get-errs (x) (nth 1 x)) (defun ghc-flymake-err-get-err-msg (x) (nth 0 x)) (defun ghc-flymake-err-get-err-act (x) (nth 1 x)) (defalias 'ghc-flymake-have-errs-p 'ghc-flymake-data) (defun ghc-flymake-data () (let* ((line-no (flymake-current-line-no)) (info (nth 0 (flymake-find-err-info flymake-err-info line-no)))) (flymake-make-err-menu-data line-no info))) (defun ghc-flymake-err-title () (ghc-flymake-err-get-title (ghc-flymake-data))) (defun ghc-flymake-err-list () (mapcar 'ghc-flymake-err-get-err-msg (ghc-flymake-err-get-errs (ghc-flymake-data)))) (defun ghc-flymake-act-list () (mapcar 'ghc-flymake-err-get-err-act (ghc-flymake-err-get-errs (ghc-flymake-data)))) (provide 'ghc-flymake) ghc-mod-3.1.4/elisp/ghc-func.el0000644000000000000000000001211212243047510014346 0ustar0000000000000000;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ghc-func.el ;;; ;; Author: Kazu Yamamoto ;; Created: Sep 25, 2009 ;;; Code: (defvar ghc-module-command "ghc-mod" "*The command name of \"ghc-mod\"") (defvar ghc-ghc-options nil "*GHC options") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ghc-replace-character (string from to) "Replace characters equal to FROM to TO in STRING." (let ((ret (copy-sequence string))) (dotimes (cnt (length ret) ret) (if (char-equal (aref ret cnt) from) (aset ret cnt to))))) (defun ghc-replace-character-buffer (from-c to-c) (let ((from (char-to-string from-c)) (to (char-to-string to-c))) (save-excursion (goto-char (point-min)) (while (search-forward from nil t) (replace-match to))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmacro ghc-add (sym val) `(setq ,sym (cons ,val ,sym))) (defun ghc-set (vars vals) (dolist (var vars) (if var (set var (car vals))) ;; var can be nil to skip (setq vals (cdr vals)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ghc-filter (pred lst) (let (ret) (dolist (x lst (reverse ret)) (if (funcall pred x) (ghc-add ret x))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ghc-uniq-lol (lol) (let ((hash (make-hash-table :test 'equal)) ret) (dolist (lst lol) (dolist (key lst) (puthash key key hash))) (maphash (lambda (key val) (ghc-add ret key)) hash) ret)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ghc-read-lisp (func) (with-temp-buffer (funcall func) (goto-char (point-min)) (condition-case nil (read (current-buffer)) (error ())))) (defun ghc-read-lisp-list (func n) (with-temp-buffer (funcall func) (goto-char (point-min)) (condition-case nil (let ((m (set-marker (make-marker) 1 (current-buffer))) ret) (dotimes (i n (nreverse ret)) (ghc-add ret (read m)))) (error ())))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ghc-mapconcat (func list) (apply 'append (mapcar func list))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst ghc-null 0) (defconst ghc-newline 10) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ghc-things-at-point () (thing-at-point 'sexp)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ghc-keyword-number-pair (spec) (let ((len (length spec)) key ret) (dotimes (i len (nreverse ret)) (setq key (intern (concat ":" (symbol-name (car spec))))) (setq ret (cons (cons key i) ret)) (setq spec (cdr spec))))) (defmacro ghc-defstruct (type &rest spec) `(progn (ghc-defstruct-constructor ,type ,@spec) (ghc-defstruct-s/getter ,type ,@spec))) (defmacro ghc-defstruct-constructor (type &rest spec) `(defun ,(intern (concat "ghc-make-" (symbol-name type))) (&rest args) (let* ((alist (quote ,(ghc-keyword-number-pair spec))) (struct (make-list (length alist) nil)) key val key-num) (while args ;; cannot use dolist (setq key (car args)) (setq args (cdr args)) (setq val (car args)) (setq args (cdr args)) (unless (keywordp key) (error "'%s' is not a keyword" key)) (setq key-num (assoc key alist)) (if key-num (setcar (nthcdr (cdr key-num) struct) val) (error "'%s' is unknown" key))) struct))) (defmacro ghc-defstruct-s/getter (type &rest spec) `(let* ((type-name (symbol-name ',type)) (keys ',spec) (len (length keys)) member-name setter getter) (dotimes (i len) (setq member-name (symbol-name (car keys))) (setq setter (intern (format "ghc-%s-set-%s" type-name member-name))) (fset setter (list 'lambda '(struct value) (list 'setcar (list 'nthcdr i 'struct) 'value) 'struct)) (setq getter (intern (format "ghc-%s-get-%s" type-name member-name))) (fset getter (list 'lambda '(struct) (list 'nth i 'struct))) (setq keys (cdr keys))))) (defun ghc-make-ghc-options () (ghc-mapconcat (lambda (x) (list "-g" x)) ghc-ghc-options)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst ghc-error-buffer-name "*GHC Info*") (defun ghc-display (fontify ins-func) (let ((buf (get-buffer-create ghc-error-buffer-name))) (with-current-buffer buf (erase-buffer) (funcall ins-func) (ghc-replace-character-buffer ghc-null ghc-newline) (goto-char (point-min)) (if (not fontify) (turn-off-haskell-font-lock) (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) ghc-mod-3.1.4/elisp/ghc-indent.el0000644000000000000000000000075312243047510014704 0ustar0000000000000000;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ghc-indent.el ;;; ;; Author: Kazu Yamamoto ;; Created: Feb 28, 2012 ;;; Code: (defvar ghc-indent-offset 4) (defun ghc-make-indent-shallower (beg end) (interactive "r") (indent-rigidly (region-beginning) (region-end) (- ghc-indent-offset))) (defun ghc-make-indent-deeper (beg end) (interactive "r") (indent-rigidly (region-beginning) (region-end) ghc-indent-offset)) (provide 'ghc-indent) ghc-mod-3.1.4/elisp/ghc-info.el0000644000000000000000000001076112243047510014356 0ustar0000000000000000;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ghc-info.el ;;; ;; Author: Kazu Yamamoto ;; Created: Nov 15, 2010 ;;; Code: (require 'ghc-func) (defun ghc-show-info (&optional ask) (interactive "P") (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-run-ghc-mod cmds))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; type ;;; (defvar ghc-type-overlay nil) (make-variable-buffer-local 'ghc-type-overlay) (defun ghc-type-set-ix (n) (overlay-put ghc-type-overlay 'ix n)) (defun ghc-type-get-ix () (overlay-get ghc-type-overlay 'ix)) (defun ghc-type-set-point (pos) (overlay-put ghc-type-overlay 'pos pos)) (defun ghc-type-get-point () (overlay-get ghc-type-overlay 'pos)) (defun ghc-type-set-types (types) (overlay-put ghc-type-overlay 'types types)) (defun ghc-type-get-types () (overlay-get ghc-type-overlay 'types)) (ghc-defstruct tinfo beg-line beg-column end-line end-column info) (defun ghc-type-init () (setq ghc-type-overlay (make-overlay 0 0)) (overlay-put ghc-type-overlay 'face 'region) (ghc-type-clear-overlay) (setq after-change-functions (cons 'ghc-type-clear-overlay after-change-functions)) (add-hook 'post-command-hook 'ghc-type-post-command-hook)) (defun ghc-type-clear-overlay (&optional beg end len) (when (overlayp ghc-type-overlay) (ghc-type-set-ix 0) (ghc-type-set-point 0) (move-overlay ghc-type-overlay 0 0))) (defun ghc-type-post-command-hook () (when (and (eq major-mode 'haskell-mode) (overlayp ghc-type-overlay) (/= (ghc-type-get-point) (point))) (ghc-type-clear-overlay))) (defun ghc-show-type () (interactive) (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)))) (defun ghc-show-type0 (modname) (let* ((buf (current-buffer)) (tinfos (ghc-type-get-tinfos modname))) (if (null tinfos) (progn (ghc-type-clear-overlay) (message "Cannot guess type")) (let* ((tinfo (nth (ghc-type-get-ix) tinfos)) (type (ghc-tinfo-get-info tinfo)) (beg-line (ghc-tinfo-get-beg-line tinfo)) (beg-column (ghc-tinfo-get-beg-column tinfo)) (end-line (ghc-tinfo-get-end-line tinfo)) (end-column (ghc-tinfo-get-end-column tinfo)) (left (ghc-get-pos buf beg-line beg-column)) (right (ghc-get-pos buf end-line end-column))) (move-overlay ghc-type-overlay (- left 1) (- right 1) buf) (message type))))) (defun ghc-type-get-tinfos (modname) (if (= (ghc-type-get-point) (point)) (ghc-type-set-ix (mod (1+ (ghc-type-get-ix)) (length (ghc-type-get-types)))) (ghc-type-set-types (ghc-type-obtain-tinfos modname)) (ghc-type-set-point (point)) (ghc-type-set-ix 0)) (ghc-type-get-types)) (defun ghc-type-obtain-tinfos (modname) (let* ((ln (int-to-string (line-number-at-pos))) (cn (int-to-string (1+ (current-column)))) (cdir default-directory) (file (buffer-file-name))) (ghc-read-lisp (lambda () (cd cdir) (apply 'call-process ghc-module-command nil t nil `(,@(ghc-make-ghc-options) "-l" "type" ,file ,modname ,ln ,cn)) (goto-char (point-min)) (while (search-forward "[Char]" nil t) (replace-match "String")))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Expanding Template Haskell ;;; (defun ghc-expand-th () (interactive) (let* ((file (buffer-file-name)) (cmds (list "expand" file)) (source (ghc-run-ghc-mod cmds))) (when source (ghc-display 'fontify (lambda () (insert source)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Misc ;;; (defun ghc-get-pos (buf line col) (save-excursion (set-buffer buf) (goto-line line) (forward-char col) (point))) (defun ghc-read-expression (default) (if default (let ((prompt (format "Expression (%s): " default))) (read-string prompt default nil)) (read-string "Expression: "))) (defun ghc-find-module-name () (save-excursion (goto-char (point-min)) (if (re-search-forward "^module[ ]+\\([^ \n]+\\)" nil t) (match-string-no-properties 1)))) (provide 'ghc-info) ghc-mod-3.1.4/elisp/ghc-ins-mod.el0000644000000000000000000000340412243047510014765 0ustar0000000000000000;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ghc-ins-mod.el ;;; ;; Author: Kazu Yamamoto ;; Created: Dec 27, 2011 ;;; Code: (defvar ghc-hoogle-command "hoogle") (defun ghc-insert-module () (interactive) (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))) (let ((mods (ghc-function-to-modules expr))) (if (null mods) (message "No module guessed") (let* ((first (car mods)) (mod (if (= (length mods) 1) first (completing-read "Module name: " mods nil t first)))) (save-excursion (ghc-goto-module-position) (insert "import " mod "\n")))))))) (defun ghc-goto-module-position () (goto-char (point-max)) (if (re-search-backward "^import" nil t) (ghc-goto-empty-line) (if (re-search-backward "^module" nil t) (ghc-goto-empty-line) (goto-char (point-min))))) (defun ghc-goto-empty-line () (unless (re-search-forward "^$" nil t) (forward-line))) ;; To avoid Data.Functor (defvar ghc-applicative-operators '("<$>" "<$" "<*>" "<**>" "<*" "*>" "<|>")) (defun ghc-function-to-modules (fn) (if (member fn ghc-applicative-operators) '("Control.Applicative") (ghc-function-to-modules-hoogle fn))) (defun ghc-function-to-modules-hoogle (fn) (with-temp-buffer (let* ((fn1 (if (string-match "^[a-zA-Z0-9'_]+$" fn) fn (concat "(" fn ")"))) (regex (concat "^\\([a-zA-Z0-9.]+\\) " fn1 " ")) ret) (call-process ghc-hoogle-command nil t nil "search" fn1) (goto-char (point-min)) (while (re-search-forward regex nil t) (setq ret (cons (match-string 1) ret))) (nreverse ret)))) (provide 'ghc-ins-mod) ghc-mod-3.1.4/elisp/ghc-pkg.el0000644000000000000000000000010512243047510014173 0ustar0000000000000000(define-package "ghc" 2.0.0 "Sub mode for Haskell mode" nil) ghc-mod-3.1.4/elisp/ghc.el0000644000000000000000000000625312243047510013426 0ustar0000000000000000;;; ghc.el --- ghc-mod front-end for haskell-mode ;; Author: Kazu Yamamoto ;; Created: Sep 25, 2009 ;; Revised: ;; Put the following code to your "~/.emacs". ;; ;; (autoload 'ghc-init "ghc" nil t) ;; (add-hook 'haskell-mode-hook (lambda () (ghc-init))) ;; Or ;; (add-hook 'haskell-mode-hook (lambda () (ghc-init) (flymake-mode))) ;;; Code: (defconst ghc-version "2.0.0") ;; (eval-when-compile ;; (require 'haskell-mode)) (require 'ghc-comp) (require 'ghc-doc) (require 'ghc-info) (require 'ghc-flymake) (require 'ghc-command) (require 'ghc-ins-mod) (require 'ghc-indent) (require 'dabbrev) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Customize Variables ;;; (defun ghc-find-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") (defvar ghc-import-key "\e\C-m") (defvar ghc-previous-key "\ep") (defvar ghc-next-key "\en") (defvar ghc-help-key "\e?") (defvar ghc-insert-key "\et") (defvar ghc-sort-key "\es") (defvar ghc-type-key "\C-c\C-t") (defvar ghc-info-key "\C-c\C-i") (defvar ghc-check-key "\C-x\C-s") (defvar ghc-toggle-key "\C-c\C-c") (defvar ghc-module-key "\C-c\C-m") (defvar ghc-expand-key "\C-c\C-e") (defvar ghc-jump-key "\C-c\C-j") (defvar ghc-hoogle-key (format "\C-c%c" (ghc-find-C-h))) (defvar ghc-shallower-key "\C-c<") (defvar ghc-deeper-key "\C-c>") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Initializer ;;; (defvar ghc-initialized nil) ;;;###autoload (defun ghc-init () (ghc-abbrev-init) (ghc-type-init) (unless ghc-initialized (define-key haskell-mode-map ghc-completion-key 'ghc-complete) (define-key haskell-mode-map ghc-document-key 'ghc-browse-document) (define-key haskell-mode-map ghc-type-key 'ghc-show-type) (define-key haskell-mode-map ghc-info-key 'ghc-show-info) (define-key haskell-mode-map ghc-expand-key 'ghc-expand-th) (define-key haskell-mode-map ghc-jump-key 'ghc-flymake-jump) (define-key haskell-mode-map ghc-import-key 'ghc-import-module) (define-key haskell-mode-map ghc-previous-key 'flymake-goto-prev-error) (define-key haskell-mode-map ghc-next-key 'flymake-goto-next-error) (define-key haskell-mode-map ghc-help-key 'ghc-flymake-display-errors) (define-key haskell-mode-map ghc-insert-key 'ghc-insert-template) (define-key haskell-mode-map ghc-sort-key 'ghc-sort-lines) (define-key haskell-mode-map ghc-check-key 'ghc-save-buffer) (define-key haskell-mode-map ghc-toggle-key 'ghc-flymake-toggle-command) (define-key haskell-mode-map ghc-module-key 'ghc-insert-module) (define-key haskell-mode-map ghc-hoogle-key 'haskell-hoogle) (define-key haskell-mode-map ghc-shallower-key 'ghc-make-indent-shallower) (define-key haskell-mode-map ghc-deeper-key 'ghc-make-indent-deeper) (ghc-comp-init) (setq ghc-initialized t))) (defun ghc-abbrev-init () (set (make-local-variable 'dabbrev-case-fold-search) nil)) (provide 'ghc) ghc-mod-3.1.4/elisp/Makefile0000644000000000000000000000166712243047510014007 0ustar0000000000000000SRCS = ghc.el ghc-func.el ghc-doc.el ghc-comp.el ghc-flymake.el \ ghc-command.el ghc-info.el ghc-ins-mod.el ghc-indent.el EMACS = emacs DETECT = xemacs TEMPFILE = temp.el all: $(TEMPFILE) ghc.el $(EMACS) -batch -q -no-site-file -l ./$(TEMPFILE) -f ghc-compile rm -f $(TEMPFILE) detect: $(TEMPFILE) ghc.el $(EMACS) -batch -q -no-site-file -l ./$(TEMPFILE) -f ghc-compile rm -f $(DETECT) $(TEMPFILE): @echo '(setq load-path (cons "." load-path))' >> $(TEMPFILE) @echo '(defun ghc-compile () (mapcar (lambda (x) (byte-compile-file x)) (list ' >> $(TEMPFILE) @echo $(SRCS)| sed -e 's/\(ghc[^ ]*\.el\)/"\1"/g' >> $(TEMPFILE) @echo ')))' >> $(TEMPFILE) clean: rm -f *.elc $(TEMPFILE) VERSION = `grep version ghc.el | sed -e 's/[^0-9\.]//g'` bump: echo "(define-package\n \"ghc-mod\"\n $(VERSION)\n \"Sub mode for Haskell mode\"\n nil)" > ghc-pkg.el archive: git archive master -o ~/ghc-$(VERSION).tar --prefix=ghc-$(VERSION)/ ghc-mod-3.1.4/Language/0000755000000000000000000000000012243047510012744 5ustar0000000000000000ghc-mod-3.1.4/Language/Haskell/0000755000000000000000000000000012243047510014327 5ustar0000000000000000ghc-mod-3.1.4/Language/Haskell/GhcMod.hs0000644000000000000000000000173312243047510016030 0ustar0000000000000000-- | The ghc-mod library. module Language.Haskell.GhcMod ( -- * Cradle Cradle(..) , findCradle -- * Options , Options(..) , LineSeparator(..) , OutputStyle(..) , defaultOptions -- * Types , ModuleString , Expression -- * 'IO' utilities , browseModule , checkSyntax , lintSyntax , infoExpr , typeExpr , listModules , listLanguages , listFlags , debugInfo -- * Converting the 'Ghc' monad to the 'IO' monad , withGHC , withGHCDummyFile -- * 'Ghc' utilities , browse , check , info , typeOf , listMods , debug ) where import Language.Haskell.GhcMod.Browse import Language.Haskell.GhcMod.Check import Language.Haskell.GhcMod.Cradle import Language.Haskell.GhcMod.Debug import Language.Haskell.GhcMod.Flag import Language.Haskell.GhcMod.GHCApi import Language.Haskell.GhcMod.Info import Language.Haskell.GhcMod.Lang import Language.Haskell.GhcMod.Lint import Language.Haskell.GhcMod.List import Language.Haskell.GhcMod.Types ghc-mod-3.1.4/Language/Haskell/GhcMod/0000755000000000000000000000000012243047510015470 5ustar0000000000000000ghc-mod-3.1.4/Language/Haskell/GhcMod/Browse.hs0000644000000000000000000001124212243047510017265 0ustar0000000000000000module Language.Haskell.GhcMod.Browse (browseModule, browse) where import Control.Applicative import Control.Monad (void) import Data.Char import Data.List 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 import Name import Outputable import TyCon import Type import Var ---------------------------------------------------------------- -- | Getting functions, classes, etc from a module. -- 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 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 cradle mdlName = do void $ initializeFlagsWithCradle opt cradle [] False getModule >>= getModuleInfo >>= listExports where getModule = findModule mdlname mpkgid `gcatch` fallback mdlname = mkModuleName mdlName mpkgid = mkFastString <$> packageId opt listExports Nothing = return [] 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 :: 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 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 e) (return . Just) tyInfo dflag <- getSessionDynFlags 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 showThing dflag (ADataCon d) = Just $ formatType dflag dataConRepType d showThing _ (ATyCon t) = unwords . toList <$> tyType t where toList t' = t' : getOccString t : map getOccString (tyConTyVars t) showThing _ _ = Nothing formatType :: NamedThing a => DynFlags -> (a -> Type) -> a -> String formatType dflag f x = showOutputable dflag (removeForAlls $ f x) tyType :: TyCon -> Maybe String tyType typ | isAlgTyCon typ && not (isNewTyCon typ) && not (isClassTyCon typ) = Just "data" | isNewTyCon typ = Just "newtype" | isClassTyCon typ = Just "class" | isSynTyCon typ = Just "type" | otherwise = Nothing removeForAlls :: Type -> Type removeForAlls ty = removeForAlls' ty' tty' where ty' = dropForAlls ty tty' = splitFunTy_maybe ty' removeForAlls' :: Type -> Maybe (Type, Type) -> Type removeForAlls' ty Nothing = ty removeForAlls' ty (Just (pre, ftype)) | isPredTy pre = mkFunTy pre (dropForAlls ftype) | otherwise = ty showOutputable :: Outputable a => DynFlags -> a -> String showOutputable dflag = unwords . lines . showUnqualifiedPage dflag . ppr ghc-mod-3.1.4/Language/Haskell/GhcMod/CabalApi.hs0000644000000000000000000001672312243047510017471 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Language.Haskell.GhcMod.CabalApi ( getCompilerOptions , parseCabalFile , cabalAllBuildInfo , cabalDependPackages , cabalSourceDirs , cabalAllTargets ) where import Control.Applicative ((<$>)) import Control.Exception (throwIO) 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)) import Distribution.PackageDescription import Distribution.PackageDescription.Configuration (finalizePackageDescription) import Distribution.PackageDescription.Parse (readPackageDescription) import Distribution.Simple.Compiler (CompilerId(..), CompilerFlavor(..)) import Distribution.Simple.Program (ghcProgram) import Distribution.Simple.Program.Types (programName, programFindVersion) import Distribution.System (buildPlatform) import Distribution.Text (display) import Distribution.Verbosity (silent) import Distribution.Version (Version) import Language.Haskell.GhcMod.Types import System.Directory (doesFileExist) import System.FilePath ---------------------------------------------------------------- -- | 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 pkgDesc idirs = includeDirectories cdir wdir $ cabalSourceDirs buildInfos depPkgs = removeThem problematicPackages $ removeMe cfile $ cabalDependPackages buildInfos ---------------------------------------------------------------- -- Dependent packages removeMe :: FilePath -> [Package] -> [Package] removeMe cabalfile = filter (/= me) where me = dropExtension $ takeFileName cabalfile removeThem :: [Package] -> [Package] -> [Package] removeThem badpkgs = filter (`notElem` badpkgs) problematicPackages :: [Package] problematicPackages = [ "base-compat" -- providing "Prelude" ] ---------------------------------------------------------------- -- Include directories for modules cabalBuildDirs :: [FilePath] cabalBuildDirs = ["dist/build", "dist/build/autogen"] includeDirectories :: FilePath -> FilePath -> [FilePath] -> [FilePath] includeDirectories cdir wdir dirs = uniqueAndSort (extdirs ++ [cdir,wdir]) where extdirs = map expand $ dirs ++ cabalBuildDirs expand "." = cdir expand subdir = cdir subdir ---------------------------------------------------------------- -- | Parsing a cabal file and returns 'PackageDescription'. -- 'IOException' is thrown if parsing fails. parseCabalFile :: FilePath -> IO PackageDescription parseCabalFile file = do cid <- getGHCId epgd <- readPackageDescription silent file case toPkgDesc cid epgd of Left deps -> throwIO $ userError $ show deps ++ " are not installed" Right (pd,_) -> if nullPkg pd then throwIO $ userError $ file ++ " is broken" else return pd where toPkgDesc cid = finalizePackageDescription [] (const True) buildPlatform cid [] nullPkg pd = name == "" where PackageName name = pkgName (package pd) ---------------------------------------------------------------- getGHCOptions :: [GHCOption] -> Cradle -> FilePath -> BuildInfo -> IO [GHCOption] getGHCOptions ghcopts cradle cdir binfo = do cabalCpp <- cabalCppOptions cdir let cpps = map ("-optP" ++) $ cppOptions binfo ++ cabalCpp 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 libs = map ("-l" ++) $ extraLibs binfo cabalCppOptions :: FilePath -> IO [String] cabalCppOptions dir = do exist <- doesFileExist cabalMacro if exist then return ["-include", cabalMacro] else return [] where cabalMacro = dir "dist/build/autogen/cabal_macros.h" ---------------------------------------------------------------- -- | Extracting all 'BuildInfo' for libraries, executables, tests and benchmarks. cabalAllBuildInfo :: PackageDescription -> [BuildInfo] cabalAllBuildInfo pd = libBI ++ execBI ++ testBI ++ benchBI where libBI = map libBuildInfo $ maybeToList $ library pd execBI = map buildInfo $ executables pd testBI = map testBuildInfo $ testSuites pd benchBI = map benchmarkBuildInfo $ benchmarks pd ---------------------------------------------------------------- -- | Extracting package names of dependency. cabalDependPackages :: [BuildInfo] -> [Package] cabalDependPackages bis = uniqueAndSort $ pkgs where pkgs = map getDependencyPackageName $ concatMap targetBuildDepends bis getDependencyPackageName (Dependency (PackageName nm) _) = nm ---------------------------------------------------------------- -- | Extracting include directories for modules. cabalSourceDirs :: [BuildInfo] -> [IncludeDir] cabalSourceDirs bis = uniqueAndSort $ concatMap hsSourceDirs bis ---------------------------------------------------------------- uniqueAndSort :: [String] -> [String] uniqueAndSort = toList . fromList ---------------------------------------------------------------- getGHCId :: IO CompilerId getGHCId = CompilerId GHC <$> getGHC getGHC :: IO Version getGHC = do mv <- programFindVersion ghcProgram silent (programName ghcProgram) 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 ghc-mod-3.1.4/Language/Haskell/GhcMod/Check.hs0000644000000000000000000000302012243047510017034 0ustar0000000000000000module Language.Haskell.GhcMod.Check (checkSyntax, check) where import Control.Applicative import Control.Monad import CoreMonad import Exception import GHC import Language.Haskell.GhcMod.ErrMsg import Language.Haskell.GhcMod.GHCApi import Language.Haskell.GhcMod.Types import Prelude ---------------------------------------------------------------- -- | Checking syntax of a target file using GHC. -- Warnings and errors are returned. checkSyntax :: Options -> Cradle -> [FilePath] -- ^ The target files. -> IO String checkSyntax _ _ [] = error "ghc-mod: checkSyntax: No files given" checkSyntax opt cradle files = unlines <$> withGHC sessionName (check opt cradle files) where sessionName = case files of [file] -> file _ -> "MultipleFiles" ---------------------------------------------------------------- -- | Checking syntax of a target file using GHC. -- Warnings and errors are returned. check :: Options -> Cradle -> [FilePath] -- ^ The target files. -> Ghc [String] check _ _ [] = error "ghc-mod: check: No files given" check opt cradle fileNames = checkIt `gcatch` handleErrMsg ls where checkIt = do (readLog,_) <- initializeFlagsWithCradle opt cradle options True setTargetFiles fileNames checkSlowAndSet void $ load LoadAllTargets liftIO readLog options | expandSplice opt = "-w:" : ghcOpts opt | otherwise = "-Wall" : ghcOpts opt ls = lineSeparator opt ghc-mod-3.1.4/Language/Haskell/GhcMod/Cradle.hs0000644000000000000000000001136212243047510017221 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} module Language.Haskell.GhcMod.Cradle ( findCradle , findCradleWithoutSandbox , getPackageDbDir ) where import Data.Char (isSpace) import Control.Applicative ((<$>)) 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) import System.FilePath ((), takeDirectory, takeFileName) ---------------------------------------------------------------- -- | Finding 'Cradle'. -- 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 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 = [] } ---------------------------------------------------------------- cabalSuffix :: String cabalSuffix = ".cabal" cabalSuffixLength :: Int cabalSuffixLength = length cabalSuffix -- 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) cabalDir :: FilePath -> IO (FilePath,FilePath) cabalDir dir = do cnts <- getCabalFiles dir case cnts of [] | dir' == dir -> throwIO $ userError "cabal files not found" | otherwise -> cabalDir dir' 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 ---------------------------------------------------------------- configFile :: String configFile = "cabal.sandbox.config" pkgDbKey :: String pkgDbKey = "package-db:" 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 -- | 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 ghc-mod-3.1.4/Language/Haskell/GhcMod/Debug.hs0000644000000000000000000000352212243047510017054 0ustar0000000000000000module Language.Haskell.GhcMod.Debug (debugInfo, debug) where import Control.Applicative import Control.Exception.IOChoice import Control.Monad import Data.List (intercalate) import Data.Maybe import GHC import GhcMonad (liftIO) import Language.Haskell.GhcMod.CabalApi import Language.Haskell.GhcMod.GHCApi import Language.Haskell.GhcMod.Types import Prelude ---------------------------------------------------------------- -- | Obtaining debug information. debugInfo :: Options -> Cradle -> FilePath -- ^ A target file. -> IO String debugInfo opt cradle fileName = unlines <$> withGHC fileName (debug opt cradle fileName) -- | Obtaining debug information. debug :: Options -> Cradle -> FilePath -- ^ A target file. -> Ghc [String] debug opt cradle fileName = do CompilerOptions gopts incDir pkgs <- if cabal then liftIO (fromCabalFile ||> return simpleCompilerOption) else return simpleCompilerOption [fast] <- do void $ initializeFlagsWithCradle opt cradle gopts True setTargetFiles [fileName] pure . canCheckFast <$> depanal [] False return [ "Current directory: " ++ currentDir , "Cabal file: " ++ cabalFile , "GHC options: " ++ unwords gopts , "Include directories: " ++ unwords incDir , "Dependent packages: " ++ intercalate ", " pkgs , "Fast check: " ++ if fast then "Yes" else "No" ] where currentDir = cradleCurrentDir cradle 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 ghc-mod-3.1.4/Language/Haskell/GhcMod/Doc.hs0000644000000000000000000000254512243047510016537 0ustar0000000000000000module Language.Haskell.GhcMod.Doc where import DynFlags (DynFlags) import Language.Haskell.GhcMod.Gap (withStyle) import Outputable import Pretty ---------------------------------------------------------------- {- pretty :: Outputable a => a -> String pretty = showSDocForUser neverQualify . ppr debug :: Outputable a => a -> b -> b debug x v = trace (pretty x) v -} ---------------------------------------------------------------- styleQualified :: PprStyle styleQualified = mkUserStyle alwaysQualify AllTheWay styleUnqualified :: PprStyle styleUnqualified = mkUserStyle neverQualify AllTheWay ---------------------------------------------------------------- -- For "ghc-mod type" showQualifiedPage :: DynFlags -> SDoc -> String showQualifiedPage dflag = showDocWith PageMode . withStyle dflag styleQualified -- For "ghc-mod browse" and show GHC's error messages. showUnqualifiedPage :: DynFlags -> SDoc -> String showUnqualifiedPage dflag = Pretty.showDocWith Pretty.PageMode . withStyle dflag styleUnqualified -- Not used showQualifiedOneLine :: DynFlags -> SDoc -> String showQualifiedOneLine dflag = showDocWith OneLineMode . withStyle dflag styleQualified -- To write Haskell code in a buffer showUnqualifiedOneLine :: DynFlags -> SDoc -> String showUnqualifiedOneLine dflag = showDocWith OneLineMode . withStyle dflag styleUnqualified ghc-mod-3.1.4/Language/Haskell/GhcMod/ErrMsg.hs0000644000000000000000000000574112243047510017232 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP #-} module Language.Haskell.GhcMod.ErrMsg ( LogReader , setLogger , handleErrMsg ) where import Bag import Control.Applicative import Data.IORef import Data.Maybe import DynFlags import ErrUtils import GHC import HscTypes import Language.Haskell.GhcMod.Doc (showUnqualifiedPage) import Language.Haskell.GhcMod.Types (LineSeparator(..)) import qualified Language.Haskell.GhcMod.Gap as Gap import Outputable import System.FilePath (normalise) ---------------------------------------------------------------- -- | A means to read the log. type LogReader = IO [String] ---------------------------------------------------------------- setLogger :: Bool -> DynFlags -> LineSeparator -> IO (DynFlags, LogReader) setLogger False df _ = return (newdf, undefined) where newdf = Gap.setLogAction df $ \_ _ _ _ _ -> return () setLogger True df ls = do ref <- newIORef [] :: IO (IORef [String]) let newdf = Gap.setLogAction df $ appendLog ref return (newdf, reverse <$> readIORef ref) where appendLog ref _ sev src _ msg = do let !l = ppMsg src sev df ls msg modifyIORef ref (l:) ---------------------------------------------------------------- handleErrMsg :: LineSeparator -> SourceError -> Ghc [String] handleErrMsg ls err = do dflag <- getSessionDynFlags return . errBagToStrList dflag ls . srcErrorMessages $ err errBagToStrList :: DynFlags -> LineSeparator -> Bag ErrMsg -> [String] errBagToStrList dflag ls = map (ppErrMsg dflag ls) . reverse . bagToList ---------------------------------------------------------------- ppErrMsg :: DynFlags -> LineSeparator -> ErrMsg -> String ppErrMsg dflag ls err = ppMsg spn SevError dflag ls msg ++ ext where spn = Gap.errorMsgSpan err msg = errMsgShortDoc err ext = showMsg dflag ls (errMsgExtraInfo err) ppMsg :: SrcSpan -> Severity-> DynFlags -> LineSeparator -> SDoc -> String ppMsg spn sev dflag ls@(LineSeparator lsep) msg = prefix ++ cts ++ lsep where cts = showMsg dflag ls msg defaultPrefix | dopt Opt_D_dump_splices dflag = "" | otherwise = "Dummy:0:0:" prefix = fromMaybe defaultPrefix $ do (line,col,_,_) <- Gap.getSrcSpan spn file <- normalise <$> Gap.getSrcFile spn let severityCaption = Gap.showSeverityCaption sev return $ file ++ ":" ++ show line ++ ":" ++ show col ++ ":" ++ severityCaption ---------------------------------------------------------------- showMsg :: DynFlags -> LineSeparator -> SDoc -> String showMsg dflag (LineSeparator [s]) sdoc = replaceNull $ showUnqualifiedPage dflag sdoc where replaceNull :: String -> String replaceNull [] = [] replaceNull ('\n':xs) = s : replaceNull xs replaceNull (x:xs) = x : replaceNull xs showMsg dflag (LineSeparator lsep) sdoc = replaceNull $ showUnqualifiedPage dflag sdoc where replaceNull [] = [] replaceNull ('\n':xs) = lsep ++ replaceNull xs replaceNull (x:xs) = x : replaceNull xs ghc-mod-3.1.4/Language/Haskell/GhcMod/Flag.hs0000644000000000000000000000067112243047510016701 0ustar0000000000000000module Language.Haskell.GhcMod.Flag where import qualified Language.Haskell.GhcMod.Gap as Gap import Language.Haskell.GhcMod.Types -- | Listing GHC flags. (e.g -fno-warn-orphans) listFlags :: Options -> IO String listFlags opt = return $ convert opt [ "-f" ++ prefix ++ option | option <- Gap.fOptions , prefix <- ["","no-"] ] ghc-mod-3.1.4/Language/Haskell/GhcMod/Gap.hs0000644000000000000000000002146112243047510016537 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP #-} module Language.Haskell.GhcMod.Gap ( Language.Haskell.GhcMod.Gap.ClsInst , mkTarget , withStyle , setLogAction , supportedExtensions , getSrcSpan , getSrcFile , setCtx , fOptions , toStringBuffer , liftIO , showSeverityCaption , setCabalPkg , addDevPkgs , filterOutChildren , infoThing , pprInfo , HasType(..) , errorMsgSpan , typeForUser , deSugar #if __GLASGOW_HASKELL__ >= 702 #else , module Pretty #endif ) where import Control.Applicative hiding (empty) import Control.Monad import Data.List import Data.Maybe import Data.Time.Clock import Desugar (deSugarExpr) import DynFlags import ErrUtils import FastString import HscTypes import Language.Haskell.GhcMod.GHCChoice import Language.Haskell.GhcMod.Types hiding (convert) import NameSet import Outputable import PprTyThing import StringBuffer import TcType import TcRnTypes import CoreSyn import qualified InstEnv import qualified Pretty import qualified StringBuffer as SB #if __GLASGOW_HASKELL__ >= 707 import FamInstEnv #endif #if __GLASGOW_HASKELL__ >= 706 import GHC hiding (ClsInst) #else import GHC hiding (Instance) #endif #if __GLASGOW_HASKELL__ >= 702 import CoreMonad (liftIO) #else import HscTypes (liftIO) import Pretty #endif #if __GLASGOW_HASKELL__ < 706 import Control.Arrow hiding ((<+>)) import Data.Convertible #endif ---------------------------------------------------------------- ---------------------------------------------------------------- -- #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 ---------------------------------------------------------------- ---------------------------------------------------------------- withStyle :: DynFlags -> PprStyle -> SDoc -> Pretty.Doc #if __GLASGOW_HASKELL__ >= 706 withStyle = withPprStyleDoc #else withStyle _ = 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 #else supportedExtensions = supportedLanguages #endif ---------------------------------------------------------------- ---------------------------------------------------------------- getSrcSpan :: SrcSpan -> Maybe (Int,Int,Int,Int) #if __GLASGOW_HASKELL__ >= 702 getSrcSpan (RealSrcSpan spn) #else getSrcSpan spn | isGoodSrcSpan spn #endif = Just (srcSpanStartLine spn , srcSpanStartCol spn , srcSpanEndLine spn , srcSpanEndCol spn) getSrcSpan _ = Nothing getSrcFile :: SrcSpan -> Maybe String #if __GLASGOW_HASKELL__ >= 702 getSrcFile (RealSrcSpan spn) = Just . unpackFS . srcSpanFile $ spn #else getSrcFile spn | isGoodSrcSpan spn = Just . unpackFS . srcSpanFile $ spn #endif getSrcFile _ = Nothing ---------------------------------------------------------------- toStringBuffer :: [String] -> Ghc StringBuffer #if __GLASGOW_HASKELL__ >= 702 toStringBuffer = return . stringToStringBuffer . unlines #else toStringBuffer = liftIO . stringToStringBuffer . unlines #endif ---------------------------------------------------------------- fOptions :: [String] #if __GLASGOW_HASKELL__ >= 704 fOptions = [option | (option,_,_) <- fFlags] ++ [option | (option,_,_) <- fWarningFlags] ++ [option | (option,_,_) <- fLangFlags] #elif __GLASGOW_HASKELL__ == 702 fOptions = [option | (option,_,_,_) <- fFlags] #else fOptions = [option | (option,_,_) <- fFlags] #endif ---------------------------------------------------------------- ---------------------------------------------------------------- setCtx :: [ModSummary] -> Ghc Bool #if __GLASGOW_HASKELL__ >= 704 setCtx ms = do #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 setCtx ms = do top <- map ms_mod <$> filterM isTop ms setContext top [] return (not . null $ top) #endif where isTop mos = lookupMod ||> returnFalse where lookupMod = lookupModule (ms_mod_name mos) Nothing >> return True returnFalse = return False showSeverityCaption :: Severity -> String #if __GLASGOW_HASKELL__ >= 706 showSeverityCaption SevWarning = "Warning: " showSeverityCaption _ = "" #else showSeverityCaption = const "" #endif ---------------------------------------------------------------- ---------------------------------------------------------------- setCabalPkg :: DynFlags -> DynFlags #if __GLASGOW_HASKELL__ >= 707 setCabalPkg dflag = gopt_set dflag Opt_BuildingCabalPackage #else setCabalPkg dflag = dopt_set dflag Opt_BuildingCabalPackage #endif ---------------------------------------------------------------- addDevPkgs :: DynFlags -> [Package] -> DynFlags addDevPkgs df [] = df addDevPkgs df pkgs = df'' where #if __GLASGOW_HASKELL__ >= 707 df' = gopt_set df Opt_HideAllPackages #else df' = dopt_set df Opt_HideAllPackages #endif df'' = df' { packageFlags = map ExposePackage pkgs ++ packageFlags df } ---------------------------------------------------------------- ---------------------------------------------------------------- class HasType a where getType :: GhcMonad m => TypecheckedModule -> a -> m (Maybe (SrcSpan, Type)) instance HasType (LHsBind Id) where #if __GLASGOW_HASKELL__ >= 707 getType _ (L spn FunBind{fun_matches = MG _ in_tys out_typ}) = return $ Just (spn, typ) where typ = mkFunTys in_tys out_typ #else getType _ (L spn FunBind{fun_matches = MatchGroup _ typ}) = return $ Just (spn, typ) #endif getType _ _ = return Nothing ---------------------------------------------------------------- ---------------------------------------------------------------- -- from ghc/InteractiveUI.hs filterOutChildren :: (a -> TyThing) -> [a] -> [a] filterOutChildren get_thing xs = [x | x <- xs, not (getName (get_thing x) `elemNameSet` implicits)] where implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)] infoThing :: String -> Ghc SDoc infoThing str = do names <- parseName str #if __GLASGOW_HASKELL__ >= 707 mb_stuffs <- mapM (getInfo False) names let filtered = filterOutChildren (\(t,_f,_i,_fam) -> t) (catMaybes mb_stuffs) #else mb_stuffs <- mapM getInfo names let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs) #endif return $ vcat (intersperse (text "") $ map (pprInfo False) filtered) #if __GLASGOW_HASKELL__ >= 707 pprInfo :: Bool -> (TyThing, GHC.Fixity, [ClsInst], [FamInst]) -> SDoc pprInfo _ (thing, fixity, insts, famInsts) = pprTyThingInContextLoc thing $$ show_fixity fixity $$ InstEnv.pprInstances insts $$ pprFamInsts famInsts where show_fixity fx | fx == defaultFixity = Outputable.empty | otherwise = ppr fx <+> ppr (getName thing) #else pprInfo :: PrintExplicitForalls -> (TyThing, GHC.Fixity, [ClsInst]) -> SDoc pprInfo pefas (thing, fixity, insts) = pprTyThingInContextLoc pefas thing $$ show_fixity fixity $$ vcat (map pprInstance insts) where 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 ghc-mod-3.1.4/Language/Haskell/GhcMod/GHCApi.hs0000644000000000000000000001441412243047510017063 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} module Language.Haskell.GhcMod.GHCApi ( withGHC , withGHCDummyFile , initializeFlags , initializeFlagsWithCradle , setTargetFiles , getDynamicFlags , setSlowDynFlags , checkSlowAndSet , canCheckFast ) where import Control.Applicative import Control.Exception import Control.Monad import CoreMonad import Data.Maybe (isJust,fromJust) import Distribution.PackageDescription (PackageDescription) import DynFlags import Exception import GHC import GHC.Paths (libdir) import Language.Haskell.GhcMod.CabalApi import Language.Haskell.GhcMod.ErrMsg import Language.Haskell.GhcMod.GHCChoice import qualified Language.Haskell.GhcMod.Gap as Gap import Language.Haskell.GhcMod.Types import System.Exit import System.IO ---------------------------------------------------------------- -- | Converting the 'Ghc' monad to the 'IO' monad. withGHCDummyFile :: Alternative m => Ghc (m a) -- ^ 'Ghc' actions created by the Ghc utilities. -> IO (m a) withGHCDummyFile = withGHC "Dummy" -- | Converting the 'Ghc' monad to the 'IO' monad. withGHC :: Alternative m => FilePath -- ^ A target file displayed in an error message. -> Ghc (m a) -- ^ 'Ghc' actions created by the Ghc utilities. -> IO (m a) withGHC file body = ghandle ignore $ runGhc (Just libdir) $ do dflags <- getSessionDynFlags defaultCleanupHandler dflags body where ignore :: Alternative m => SomeException -> IO (m a) ignore e = do hPutStr stderr $ file ++ ":0:0:Error:" hPrint stderr e exitSuccess ---------------------------------------------------------------- importDirs :: [IncludeDir] importDirs = [".","..","../..","../../..","../../../..","../../../../.."] data Build = CabalPkg | SingleFile deriving Eq -- | 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, Maybe PackageDescription) initializeFlagsWithCradle opt cradle ghcopts logging | cabal = withCabal |||> withoutCabal | otherwise = withoutCabal where mCradleFile = cradleCabalFile cradle cabal = isJust mCradleFile withCabal = do 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 -> CompilerOptions -> Bool -> m LogReader 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 depPkgs (expandSplice opt) build df3 <- modifyFlagsWithOpts df2 $ ghcOpts opt liftIO $ setLogger logging df3 ls ---------------------------------------------------------------- -- | Initialize the 'DynFlags' relating to the compilation of a single -- file or GHC session. initializeFlags :: GhcMonad m => Options -> m () initializeFlags opt = do dflags0 <- getSessionDynFlags dflags1 <- modifyFlagsWithOpts dflags0 $ ghcOpts opt void $ setSessionDynFlags dflags1 ---------------------------------------------------------------- -- FIXME removing Options 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 = Gap.addDevPkgs d2 depPkgs d4 | build == CabalPkg = Gap.setCabalPkg d3 | otherwise = d3 setSplice :: DynFlags -> DynFlags setSplice dflag = dopt_set dflag Opt_D_dump_splices ---------------------------------------------------------------- setFastOrNot :: DynFlags -> CheckSpeed -> DynFlags setFastOrNot dflags Slow = dflags { ghcLink = LinkInMemory , hscTarget = HscInterpreted } setFastOrNot dflags Fast = dflags { ghcLink = NoLink , hscTarget = HscNothing } setSlowDynFlags :: GhcMonad m => m () setSlowDynFlags = (flip setFastOrNot Slow <$> getSessionDynFlags) >>= void . setSessionDynFlags -- | To check TH, a session module graph is necessary. -- "load" sets a session module graph using "depanal". -- But we have to set "-fno-code" to DynFlags before "load". -- So, this is necessary redundancy. checkSlowAndSet :: GhcMonad m => m () checkSlowAndSet = do fast <- canCheckFast <$> depanal [] False unless fast setSlowDynFlags ---------------------------------------------------------------- modifyFlagsWithOpts :: GhcMonad m => DynFlags -> [GHCOption] -> m DynFlags modifyFlagsWithOpts dflags cmdOpts = tfst <$> parseDynamicFlags dflags (map noLoc cmdOpts) where tfst (a,_,_) = a ---------------------------------------------------------------- -- | Set the files that GHC will load / compile. setTargetFiles :: (GhcMonad m) => [FilePath] -> m () setTargetFiles [] = error "ghc-mod: setTargetFiles: No target files given" setTargetFiles files = do targets <- forM files $ \file -> guessTarget file Nothing setTargets targets ---------------------------------------------------------------- -- | Return the 'DynFlags' currently in use in the GHC session. getDynamicFlags :: IO DynFlags getDynamicFlags = runGhc (Just libdir) getSessionDynFlags -- | Checking if Template Haskell or quasi quotes are used. -- If not, the process can be faster. canCheckFast :: ModuleGraph -> Bool canCheckFast = not . any (hasTHorQQ . ms_hspp_opts) where hasTHorQQ :: DynFlags -> Bool hasTHorQQ dflags = any (`xopt` dflags) [Opt_TemplateHaskell, Opt_QuasiQuotes] ghc-mod-3.1.4/Language/Haskell/GhcMod/GHCChoice.hs0000644000000000000000000000154412243047510017544 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} module Language.Haskell.GhcMod.GHCChoice where import Control.Exception import CoreMonad import Exception import GHC ---------------------------------------------------------------- -- | Try the left 'Ghc' action. If 'IOException' occurs, try -- the right 'Ghc' action. (||>) :: Ghc a -> Ghc a -> Ghc a x ||> y = x `gcatch` (\(_ :: IOException) -> y) -- | Go to the next 'Ghc' monad by throwing 'AltGhcgoNext'. goNext :: Ghc a goNext = liftIO . throwIO $ userError "goNext" -- | Run any one 'Ghc' monad. runAnyOne :: [Ghc a] -> Ghc a runAnyOne = foldr (||>) goNext ---------------------------------------------------------------- -- | Try the left 'GhcMonad' action. If 'IOException' occurs, try -- the right 'GhcMonad' action. (|||>) :: GhcMonad m => m a -> m a -> m a x |||> y = x `gcatch` (\(_ :: IOException) -> y) ghc-mod-3.1.4/Language/Haskell/GhcMod/Info.hs0000644000000000000000000001377512243047510016734 0ustar0000000000000000{-# LANGUAGE TupleSections, FlexibleInstances, TypeSynonymInstances, CPP #-} {-# LANGUAGE Rank2Types #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Language.Haskell.GhcMod.Info ( infoExpr , info , typeExpr , typeOf ) where import Control.Applicative import Control.Monad (void, when) import CoreUtils import Data.Function import Data.Generics hiding (typeOf) import Data.List import Data.Maybe import Data.Ord as O import Data.Time.Clock import GHC import GHC.SYB.Utils import HscTypes import Language.Haskell.GhcMod.Doc import Language.Haskell.GhcMod.GHCApi import Language.Haskell.GhcMod.GHCChoice import qualified Language.Haskell.GhcMod.Gap as Gap import Language.Haskell.GhcMod.Gap (HasType(..)) import Language.Haskell.GhcMod.Types import Outputable import TcHsSyn (hsPatType) ---------------------------------------------------------------- data Cmd = Info | Type deriving Eq ---------------------------------------------------------------- -- | Obtaining information of a target expression. (GHCi's info:) infoExpr :: Options -> Cradle -> FilePath -- ^ A target file. -> ModuleString -- ^ A module name. -> Expression -- ^ A Haskell expression. -> IO String infoExpr opt cradle file modstr expr = (++ "\n") <$> withGHCDummyFile (info opt cradle file modstr expr) -- | Obtaining information of a target expression. (GHCi's info:) info :: Options -> Cradle -> FilePath -- ^ A target file. -> ModuleString -- ^ A module name. -> Expression -- ^ A Haskell expression. -> Ghc String info opt cradle file modstr expr = inModuleContext Info opt cradle file modstr exprToInfo "Cannot show info" where exprToInfo = do dflag <- getSessionDynFlags sdoc <- Gap.infoThing expr return $ showUnqualifiedPage dflag sdoc ---------------------------------------------------------------- instance HasType (LHsExpr Id) where getType tcm e = do hs_env <- getSession mbe <- Gap.liftIO $ Gap.deSugar tcm e hs_env return $ (getLoc e, ) <$> CoreUtils.exprType <$> mbe instance HasType (LPat Id) where getType _ (L spn pat) = return $ Just (spn, hsPatType pat) ---------------------------------------------------------------- -- | Obtaining type of a target expression. (GHCi's type:) typeExpr :: Options -> Cradle -> FilePath -- ^ A target file. -> ModuleString -- ^ A odule name. -> Int -- ^ Line number. -> Int -- ^ Column number. -> IO String typeExpr opt cradle file modstr lineNo colNo = withGHCDummyFile $ typeOf opt cradle file modstr lineNo colNo -- | Obtaining type of a target expression. (GHCi's type:) typeOf :: Options -> Cradle -> FilePath -- ^ A target file. -> ModuleString -- ^ A odule name. -> Int -- ^ Line number. -> Int -- ^ Column number. -> Ghc String typeOf opt cradle file modstr lineNo colNo = inModuleContext Type opt cradle file modstr exprToType errmsg where exprToType = do modSum <- getModSummary $ mkModuleName modstr p <- parseModule modSum tcm@TypecheckedModule{tm_typechecked_source = tcs} <- typecheckModule p let bs = listifySpans tcs (lineNo, colNo) :: [LHsBind Id] es = listifySpans tcs (lineNo, colNo) :: [LHsExpr Id] ps = listifySpans tcs (lineNo, colNo) :: [LPat Id] bts <- mapM (getType tcm) bs ets <- mapM (getType tcm) es pts <- mapM (getType tcm) ps dflag <- getSessionDynFlags let sss = map (toTup dflag) $ sortBy (cmp `on` fst) $ catMaybes $ concat [ets, bts, pts] return $ convert opt sss toTup :: DynFlags -> (SrcSpan, Type) -> ((Int,Int,Int,Int),String) toTup dflag (spn, typ) = (fourInts spn, pretty dflag typ) fourInts :: SrcSpan -> (Int,Int,Int,Int) fourInts = fromMaybe (0,0,0,0) . Gap.getSrcSpan cmp a b | a `isSubspanOf` b = O.LT | b `isSubspanOf` a = O.GT | otherwise = O.EQ errmsg = convert opt ([] :: [((Int,Int,Int,Int),String)]) listifySpans :: Typeable a => TypecheckedSource -> (Int, Int) -> [Located a] listifySpans tcs lc = listifyStaged TypeChecker p tcs where p (L spn _) = isGoodSrcSpan spn && spn `spans` lc listifyStaged :: Typeable r => Stage -> (r -> Bool) -> GenericQ [r] listifyStaged s p = everythingStaged s (++) [] ([] `mkQ` (\x -> [x | p x])) pretty :: DynFlags -> Type -> String pretty dflag = showUnqualifiedOneLine dflag . Gap.typeForUser ---------------------------------------------------------------- inModuleContext :: Cmd -> Options -> Cradle -> FilePath -> ModuleString -> Ghc String -> String -> Ghc String inModuleContext cmd opt cradle file modstr action errmsg = valid ||> invalid ||> return errmsg where valid = do void $ initializeFlagsWithCradle opt cradle ["-w:"] False when (cmd == Info) setSlowDynFlags setTargetFiles [file] checkSlowAndSet void $ load LoadAllTargets doif setContextFromTarget action invalid = do void $ initializeFlagsWithCradle opt cradle ["-w:"] False setTargetBuffer checkSlowAndSet void $ load LoadAllTargets doif setContextFromTarget action setTargetBuffer = do modgraph <- depanal [mkModuleName modstr] True dflag <- getSessionDynFlags let imports = concatMap (map (showQualifiedPage dflag . 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 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 setContextFromTarget :: Ghc Bool setContextFromTarget = depanal [] False >>= Gap.setCtx ghc-mod-3.1.4/Language/Haskell/GhcMod/Internal.hs0000644000000000000000000000150612243047510017602 0ustar0000000000000000-- | Low level access to the ghc-mod library. module Language.Haskell.GhcMod.Internal ( -- * Types LogReader , GHCOption , Package , IncludeDir , CompilerOptions(..) -- * Cabal API , parseCabalFile , getCompilerOptions , cabalAllBuildInfo , cabalDependPackages , cabalSourceDirs , cabalAllTargets -- * GHC API , canCheckFast -- * Getting 'DynFlags' , getDynamicFlags -- * Initializing 'DynFlags' , initializeFlags , initializeFlagsWithCradle -- * 'GhcMonad' , setTargetFiles , checkSlowAndSet -- * 'Ghc' Choice , (||>) , goNext , runAnyOne -- * 'GhcMonad' Choice , (|||>) ) where import Language.Haskell.GhcMod.CabalApi import Language.Haskell.GhcMod.ErrMsg import Language.Haskell.GhcMod.GHCApi import Language.Haskell.GhcMod.GHCChoice import Language.Haskell.GhcMod.Types ghc-mod-3.1.4/Language/Haskell/GhcMod/Lang.hs0000644000000000000000000000041712243047510016707 0ustar0000000000000000module Language.Haskell.GhcMod.Lang where import qualified Language.Haskell.GhcMod.Gap as Gap import Language.Haskell.GhcMod.Types -- | Listing language extensions. listLanguages :: Options -> IO String listLanguages opt = return $ convert opt Gap.supportedExtensions ghc-mod-3.1.4/Language/Haskell/GhcMod/Lint.hs0000644000000000000000000000117012243047510016731 0ustar0000000000000000module Language.Haskell.GhcMod.Lint where import Control.Applicative import Data.List import Language.Haskell.GhcMod.Types import Language.Haskell.HLint -- | Checking syntax of a target file using hlint. -- Warnings and errors are returned. lintSyntax :: Options -> FilePath -- ^ A target file. -> IO String lintSyntax opt file = pack <$> lint opt file where LineSeparator lsep = lineSeparator opt pack = unlines . map (intercalate lsep . lines) lint :: Options -> FilePath -- ^ A target file. -> IO [String] lint opt file = map show <$> hlint ([file, "--quiet"] ++ hlintOpts opt) ghc-mod-3.1.4/Language/Haskell/GhcMod/List.hs0000644000000000000000000000204212243047510016735 0ustar0000000000000000module Language.Haskell.GhcMod.List (listModules, listMods) where import Control.Applicative import Control.Monad (void) import Data.List import GHC import Language.Haskell.GhcMod.GHCApi import Language.Haskell.GhcMod.Types import Packages import UniqFM ---------------------------------------------------------------- -- | Listing installed modules. 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 -> Cradle -> Ghc [(String, String)] listMods opt cradle = do void $ initializeFlagsWithCradle opt cradle [] False getExposedModules <$> getSessionDynFlags where getExposedModules = concatMap exposedModules' . eltsUFM . pkgIdMap . pkgState exposedModules' p = map moduleNameString (exposedModules p) `zip` repeat (display $ sourcePackageId p) ghc-mod-3.1.4/Language/Haskell/GhcMod/Types.hs0000644000000000000000000000676212243047510017143 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} module Language.Haskell.GhcMod.Types where -- | Output style. data OutputStyle = LispStyle -- ^ S expression style. | PlainStyle -- ^ Plain textstyle. -- | The type for line separator. Historically, a Null string is used. newtype LineSeparator = LineSeparator String data Options = Options { outputStyle :: OutputStyle , hlintOpts :: [String] , ghcOpts :: [String] -- | If 'True', 'browse' also returns operators. , 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'. defaultOptions :: Options defaultOptions = Options { outputStyle = PlainStyle , hlintOpts = [] , ghcOpts = [] , operators = False , detailed = False , qualified = False , expandSplice = False , lineSeparator = LineSeparator "\0" , packageId = Nothing } ---------------------------------------------------------------- convert :: ToString a => Options -> a -> String convert Options{ outputStyle = LispStyle } = toLisp convert Options{ outputStyle = PlainStyle } = toPlain class ToString a where toLisp :: a -> String toPlain :: a -> String instance ToString [String] where toLisp = addNewLine . toSexp True toPlain = unlines instance ToString [((Int,Int,Int,Int),String)] where toLisp = addNewLine . toSexp False . map toS where toS x = "(" ++ tupToString x ++ ")" toPlain = unlines . map tupToString toSexp :: Bool -> [String] -> String toSexp False ss = "(" ++ unwords ss ++ ")" toSexp True ss = "(" ++ unwords (map quote ss) ++ ")" tupToString :: ((Int,Int,Int,Int),String) -> String tupToString ((a,b,c,d),s) = show a ++ " " ++ show b ++ " " ++ show c ++ " " ++ show d ++ " " ++ quote s quote :: String -> String quote x = "\"" ++ x ++ "\"" addNewLine :: String -> String addNewLine = (++ "\n") ---------------------------------------------------------------- -- | The environment where this library is used. data Cradle = Cradle { -- | The directory where this library is executed. cradleCurrentDir :: FilePath -- | The directory where a cabal file is found. , cradleCabalDir :: Maybe FilePath -- | The file name of the found cabal file. , cradleCabalFile :: 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 command line option. type GHCOption = String -- | An include directory for modules. type IncludeDir = FilePath -- | A package name. type Package = String -- | Haskell expression. type Expression = String -- | Module name. 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) ghc-mod-3.1.4/src/0000755000000000000000000000000012243047510012010 5ustar0000000000000000ghc-mod-3.1.4/src/GHCMod.hs0000644000000000000000000001403412243047510013407 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Main where import Control.Applicative import Control.Exception import Control.Monad import Data.Typeable import Data.Version import Language.Haskell.GhcMod import Paths_ghc_mod import Prelude import System.Console.GetOpt import System.Directory import System.Environment (getArgs) import System.Exit (exitFailure) import System.IO (hPutStr, hPutStrLn, stdout, stderr, hSetEncoding, utf8) ---------------------------------------------------------------- ghcOptHelp :: String ghcOptHelp = " [-g GHC_opt1 -g GHC_opt2 ...] " usage :: String usage = "ghc-mod version " ++ showVersion version ++ "\n" ++ "Usage:\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] [-q] [-p package] [ ...]\n" ++ "\t ghc-mod check" ++ ghcOptHelp ++ "\n" ++ "\t ghc-mod expand" ++ ghcOptHelp ++ "\n" ++ "\t ghc-mod debug" ++ ghcOptHelp ++ "\n" ++ "\t ghc-mod info" ++ ghcOptHelp ++ " \n" ++ "\t ghc-mod type" ++ ghcOptHelp ++ " \n" ++ "\t ghc-mod lint [-h opt] \n" ++ "\t ghc-mod boot\n" ++ "\t ghc-mod help\n" ---------------------------------------------------------------- argspec :: [OptDescr (Options -> Options)] argspec = [ Option "l" ["tolisp"] (NoArg (\opts -> opts { outputStyle = LispStyle })) "print as a list of Lisp" , Option "h" ["hlintOpt"] (ReqArg (\h opts -> opts { hlintOpts = h : hlintOpts opts }) "hlintOpt") "hlint options" , Option "g" ["ghcOpt"] (ReqArg (\g opts -> opts { ghcOpts = g : ghcOpts opts }) "ghcOpt") "GHC options" , Option "o" ["operators"] (NoArg (\opts -> opts { operators = True })) "print operators, too" , 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)" ] parseArgs :: [OptDescr (Options -> Options)] -> [String] -> (Options, [String]) parseArgs spec argv = case getOpt Permute spec argv of (o,n,[] ) -> (foldr id defaultOptions o, n) (_,_,errs) -> throw (CmdArg errs) ---------------------------------------------------------------- data GHCModError = SafeList | TooManyArguments String | NoSuchCommand String | CmdArg [String] | FileNotExist String deriving (Show, Typeable) instance Exception GHCModError ---------------------------------------------------------------- main :: IO () main = flip catches handlers $ do -- #if __GLASGOW_HASKELL__ >= 611 hSetEncoding stdout utf8 -- #endif args <- getArgs let (opt,cmdArg) = parseArgs argspec args cradle <- findCradle let cmdArg0 = cmdArg !. 0 cmdArg1 = cmdArg !. 1 cmdArg2 = cmdArg !. 2 cmdArg3 = cmdArg !. 3 cmdArg4 = cmdArg !. 4 remainingArgs = tail cmdArg nArgs n f = if length remainingArgs == n then f else throw (TooManyArguments cmdArg0) res <- case cmdArg0 of "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 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 cradle langs <- listLanguages opt flags <- listFlags opt pre <- concat <$> mapM (browseModule opt cradle) preBrowsedModules return $ mods ++ langs ++ flags ++ pre "help" -> return $ usageInfo usage argspec cmd -> throw (NoSuchCommand cmd) putStr res where handlers = [Handler (handleThenExit handler1), Handler (handleThenExit handler2)] handleThenExit handler = \e -> handler e >> exitFailure handler1 :: ErrorCall -> IO () handler1 = print -- for debug handler2 :: GHCModError -> IO () handler2 SafeList = printUsage handler2 (TooManyArguments cmd) = do hPutStrLn stderr $ "\"" ++ cmd ++ "\": Too many arguments" printUsage handler2 (NoSuchCommand cmd) = do hPutStrLn stderr $ "\"" ++ cmd ++ "\" not supported" printUsage handler2 (CmdArg errs) = do mapM_ (hPutStr stderr) errs printUsage handler2 (FileNotExist file) = do hPutStrLn stderr $ "\"" ++ file ++ "\" not found" printUsage printUsage = hPutStrLn stderr $ '\n' : usageInfo usage argspec withFile cmd file = do exist <- doesFileExist file if exist then cmd file else throw (FileNotExist file) xs !. idx | length xs <= idx = throw SafeList | otherwise = xs !! idx ---------------------------------------------------------------- preBrowsedModules :: [String] preBrowsedModules = [ "Prelude" , "Control.Applicative" , "Control.Monad" , "Control.Exception" , "Data.Char" , "Data.List" , "Data.Maybe" , "System.IO" ] ghc-mod-3.1.4/test/0000755000000000000000000000000012243047510012200 5ustar0000000000000000ghc-mod-3.1.4/test/BrowseSpec.hs0000644000000000000000000000244112243047510014611 0ustar0000000000000000module BrowseSpec where 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 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 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 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"] ghc-mod-3.1.4/test/CabalApiSpec.hs0000644000000000000000000001147412243047510015012 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} module CabalApiSpec where 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" pkgs `shouldBe` ["Cabal","base","template-haskell"] describe "cabalSourceDirs" $ do 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 "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 = []})))]}]" ghc-mod-3.1.4/test/CheckSpec.hs0000644000000000000000000000320112243047510014360 0ustar0000000000000000module CheckSpec where import Data.List (isSuffixOf, isInfixOf, isPrefixOf) import Language.Haskell.GhcMod import Language.Haskell.GhcMod.Cradle import System.FilePath import Test.Hspec import Dir spec :: Spec spec = do describe "checkSyntax" $ do it "can check even if an executable depends on its library" $ do withDirectory_ "test/data/ghc-mod-check" $ do 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 <- 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 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 <- findCradleWithoutSandbox res <- checkSyntax defaultOptions cradle ["Baz.hs"] res `shouldSatisfy` ("Baz.hs:5:1:Warning:" `isPrefixOf`) ghc-mod-3.1.4/test/DebugSpec.hs0000644000000000000000000000123012243047510014371 0ustar0000000000000000module DebugSpec where import Language.Haskell.GhcMod import Test.Hspec import Dir checkFast :: String -> String -> IO () checkFast file ans = withDirectory_ "test/data" $ do let cradle = Cradle "." Nothing Nothing [] res <- debugInfo defaultOptions cradle file lines res `shouldContain` [ans] spec :: Spec spec = do describe "debug" $ do it "can check TH" $ do 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" ghc-mod-3.1.4/test/Dir.hs0000644000000000000000000000152512243047510013255 0ustar0000000000000000module Dir where 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 setCurrentDirectory (\_ -> setCurrentDirectory dir >> action) withDirectory :: FilePath -> (FilePath -> IO a) -> IO a 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' ghc-mod-3.1.4/test/doctests.hs0000644000000000000000000000020512243047510014361 0ustar0000000000000000module Main where import Test.DocTest main :: IO () main = doctest [ "-package" , "ghc" , "Language/Haskell/GhcMod.hs" ] ghc-mod-3.1.4/test/FlagSpec.hs0000644000000000000000000000045612243047510014225 0ustar0000000000000000module FlagSpec where import Control.Applicative import Language.Haskell.GhcMod import Test.Hspec spec :: Spec spec = do describe "listFlags" $ do it "lists up GHC flags" $ do flags <- lines <$> listFlags defaultOptions flags `shouldContain` ["-fno-warn-orphans"] ghc-mod-3.1.4/test/InfoSpec.hs0000644000000000000000000000535212243047510014247 0ustar0000000000000000{-# 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 import Dir spec :: Spec spec = do describe "typeExpr" $ do it "shows types of the expression and its outers" $ do withDirectory_ "test/data/ghc-mod-check" $ do 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 <- 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 <- 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 <- 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 <- 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 <- findCradleWithoutSandbox res <- infoExpr defaultOptions cradle "Main.hs" "Main" "bar" res `shouldSatisfy` ("bar :: [Char]" `isPrefixOf`) it "doesn't fail on unicode output" $ do 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 ghc-mod-3.1.4/test/LangSpec.hs0000644000000000000000000000047612243047510014237 0ustar0000000000000000module LangSpec where import Control.Applicative import Language.Haskell.GhcMod import Test.Hspec spec :: Spec spec = do describe "listLanguages" $ do it "lists up language extensions" $ do exts <- lines <$> listLanguages defaultOptions exts `shouldContain` ["OverloadedStrings"] ghc-mod-3.1.4/test/LintSpec.hs0000644000000000000000000000062012243047510014253 0ustar0000000000000000module LintSpec where import Language.Haskell.GhcMod import Test.Hspec spec :: Spec spec = do describe "lintSyntax" $ do it "check syntax with HList" $ do res <- lintSyntax defaultOptions "test/data/hlint.hs" res `shouldBe` "test/data/hlint.hs:4:8: Error: Redundant do\NULFound:\NUL do putStrLn \"Hello, world!\"\NULWhy not:\NUL putStrLn \"Hello, world!\"\n" ghc-mod-3.1.4/test/ListSpec.hs0000644000000000000000000000053012243047510014260 0ustar0000000000000000module ListSpec where import Control.Applicative import Language.Haskell.GhcMod import Test.Hspec spec :: Spec spec = do describe "listModules" $ do it "lists up module names" $ do cradle <- findCradle modules <- lines <$> listModules defaultOptions cradle modules `shouldContain` ["Data.Map"] ghc-mod-3.1.4/test/Spec.hs0000644000000000000000000000005412243047510013425 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} ghc-mod-3.1.4/test/data/0000755000000000000000000000000012243047510013111 5ustar0000000000000000ghc-mod-3.1.4/test/data/Bar.hs0000644000000000000000000000013612243047510014151 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module Bar (bar) where import Foo (foo) bar = $foo ++ "bar" ghc-mod-3.1.4/test/data/Baz.hs0000644000000000000000000000014312243047510014157 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} module Baz (baz) where import Foo (fooQ) baz = [fooQ| foo bar baz |] ghc-mod-3.1.4/test/data/cabal.sandbox.config0000644000000000000000000000173312243047510017003 0ustar0000000000000000-- This is a Cabal package environment file. -- THIS FILE IS AUTO-GENERATED. DO NOT EDIT DIRECTLY. -- Please create a 'cabal.config' file in the same directory -- if you want to change the default settings for this sandbox. 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: /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: /home/me/work/ghc-mod/test/data/.cabal-sandbox bindir: $prefix/bin libdir: $prefix/lib libsubdir: $arch-$os-$compiler/$pkgid libexecdir: $prefix/libexec datadir: $prefix/share datasubdir: $arch-$os-$compiler/$pkgid docdir: $datadir/doc/$arch-$os-$compiler/$pkgid htmldir: $docdir/html haddockdir: $htmldir sysconfdir: $prefix/etc ghc-mod-3.1.4/test/data/cabalapi.cabal0000644000000000000000000000474412243047510015642 0ustar0000000000000000Name: ghc-mod Version: 1.11.3 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 License-File: LICENSE Homepage: http://www.mew.org/~kazu/proj/ghc-mod/ Synopsis: Happy Haskell programming on Emacs/Vim Description: This packages includes Elisp files and a Haskell command, "ghc-mod". "ghc*.el" enable completion of Haskell symbols on Emacs. Flymake is also integrated. "ghc-mod" is a backend of "ghc*.el". It lists up all installed modules or extracts names of functions, classes, and data declarations. To use "ghc-mod" on Vim, see or Category: Development Cabal-Version: >= 1.6 Build-Type: Simple Data-Dir: elisp Data-Files: Makefile ghc.el ghc-func.el ghc-doc.el ghc-comp.el ghc-flymake.el ghc-command.el ghc-info.el ghc-ins-mod.el ghc-indent.el Executable ghc-mod Main-Is: GHCMod.hs Other-Modules: Browse CabalApi Cabal CabalDev Check ErrMsg Flag GHCApi GHCChoice Gap Info Lang Lint List Paths_ghc_mod Types GHC-Options: -Wall Build-Depends: base >= 4.0 && < 5 , Cabal >= 1.10 , template-haskell Test-Suite spec Main-Is: Spec.hs Hs-Source-Dirs: test, . Type: exitcode-stdio-1.0 Other-Modules: Expectation BrowseSpec CabalApiSpec FlagSpec LangSpec LintSpec ListSpec Build-Depends: base >= 4.0 && < 5 , Cabal >= 1.10 Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/ghc-mod.git ghc-mod-3.1.4/test/data/Foo.hs0000644000000000000000000000034312243047510014170 0ustar0000000000000000module 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 ghc-mod-3.1.4/test/data/hlint.hs0000644000000000000000000000011112243047510014554 0ustar0000000000000000module Hlist where main :: IO () main = do putStrLn "Hello, world!" ghc-mod-3.1.4/test/data/Info.hs0000644000000000000000000000013612243047510014340 0ustar0000000000000000module Info () where fib :: Int -> Int fib 0 = 0 fib 1 = 1 fib n = fib (n - 1) + fib (n - 2) ghc-mod-3.1.4/test/data/Main.hs0000644000000000000000000000004612243047510014331 0ustar0000000000000000import Bar (bar) main = putStrLn bar ghc-mod-3.1.4/test/data/Mutual1.hs0000644000000000000000000000004512243047510014774 0ustar0000000000000000module Mutual1 where import Mutual2 ghc-mod-3.1.4/test/data/Mutual2.hs0000644000000000000000000000004512243047510014775 0ustar0000000000000000module Mutual2 where import Mutual1 ghc-mod-3.1.4/test/data/Unicode.hs0000644000000000000000000000006712243047510015036 0ustar0000000000000000module Unicode where unicode :: α -> α unicode = id ghc-mod-3.1.4/test/data/.cabal-sandbox/0000755000000000000000000000000012243047510015665 5ustar0000000000000000ghc-mod-3.1.4/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/0000755000000000000000000000000012243047510023317 5ustar0000000000000000ghc-mod-3.1.4/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/dummy0000644000000000000000000000000612243047510024371 0ustar0000000000000000dummy ghc-mod-3.1.4/test/data/broken-cabal/0000755000000000000000000000000012243047510015431 5ustar0000000000000000ghc-mod-3.1.4/test/data/broken-cabal/broken.cabal0000644000000000000000000000001512243047510017671 0ustar0000000000000000broken cabal ghc-mod-3.1.4/test/data/broken-sandbox/0000755000000000000000000000000012243047510016025 5ustar0000000000000000ghc-mod-3.1.4/test/data/broken-sandbox/cabal.sandbox.config0000644000000000000000000000000712243047510021710 0ustar0000000000000000broken ghc-mod-3.1.4/test/data/broken-sandbox/dummy.cabal0000644000000000000000000000000612243047510020140 0ustar0000000000000000dummy ghc-mod-3.1.4/test/data/check-test-subdir/0000755000000000000000000000000012243047510016431 5ustar0000000000000000ghc-mod-3.1.4/test/data/check-test-subdir/check-test-subdir.cabal0000644000000000000000000000044412243047510022737 0ustar0000000000000000name: check-test-subdir version: 0.1.0 build-type: Simple cabal-version: >= 1.8 library build-depends: base == 4.* hs-source-dirs: src exposed-modules: Check.Test.Subdir test-suite test type: exitcode-stdio-1.0 build-depends: base == 4.* hs-source-dirs: test main-is: Main.hs ghc-mod-3.1.4/test/data/check-test-subdir/src/0000755000000000000000000000000012243047510017220 5ustar0000000000000000ghc-mod-3.1.4/test/data/check-test-subdir/src/Check/0000755000000000000000000000000012243047510020235 5ustar0000000000000000ghc-mod-3.1.4/test/data/check-test-subdir/src/Check/Test/0000755000000000000000000000000012243047510021154 5ustar0000000000000000ghc-mod-3.1.4/test/data/check-test-subdir/src/Check/Test/Subdir.hs0000644000000000000000000000011412243047510022734 0ustar0000000000000000module Check.Test.Subdir (subdir) where subdir :: String subdir = "subdir" ghc-mod-3.1.4/test/data/check-test-subdir/test/0000755000000000000000000000000012243047510017410 5ustar0000000000000000ghc-mod-3.1.4/test/data/check-test-subdir/test/Foo.hs0000644000000000000000000000004412243047510020465 0ustar0000000000000000module Foo (foo) where foo = "foo" ghc-mod-3.1.4/test/data/check-test-subdir/test/Main.hs0000644000000000000000000000011212243047510020622 0ustar0000000000000000module Main where import Bar.Baz (baz) main :: IO () main = putStrLn baz ghc-mod-3.1.4/test/data/check-test-subdir/test/Bar/0000755000000000000000000000000012243047510020114 5ustar0000000000000000ghc-mod-3.1.4/test/data/check-test-subdir/test/Bar/Baz.hs0000644000000000000000000000012612243047510021163 0ustar0000000000000000module Bar.Baz (baz) where import Foo (foo) baz :: String baz = unwords [foo, "baz"] ghc-mod-3.1.4/test/data/ghc-mod-check/0000755000000000000000000000000012243047510015502 5ustar0000000000000000ghc-mod-3.1.4/test/data/ghc-mod-check/ghc-mod-check.cabal0000644000000000000000000000133312243047510021057 0ustar0000000000000000-- Initial ghc-mod-check.cabal generated by cabal init. For further -- documentation, see http://haskell.org/cabal/users-guide/ name: ghc-mod-check version: 0.1.0.0 synopsis: check test -- description: license: BSD3 license-file: LICENSE author: Kazu Yamamoto maintainer: kazu@iij.ad.jp -- copyright: category: Data build-type: Simple cabal-version: >=1.8 library -- exposed-modules: -- other-modules: build-depends: base exposed-modules: Data.Foo executable foo Main-Is: main.hs GHC-Options: -Wall Build-Depends: base >= 4 && < 5 , ghc-mod-check ghc-mod-3.1.4/test/data/ghc-mod-check/main.hs0000644000000000000000000000006512243047510016763 0ustar0000000000000000module Main where import Data.Foo main = print foo ghc-mod-3.1.4/test/data/ghc-mod-check/Data/0000755000000000000000000000000012243047510016353 5ustar0000000000000000ghc-mod-3.1.4/test/data/ghc-mod-check/Data/Foo.hs0000644000000000000000000000027312243047510017434 0ustar0000000000000000module Data.Foo where foo :: Int foo = undefined fibonacci :: Int -> Integer fibonacci n = fib 1 0 1 where fib m x y | n == m = y | otherwise = fib (m+1) y (x + y) ghc-mod-3.1.4/test/data/subdir1/0000755000000000000000000000000012243047510014462 5ustar0000000000000000ghc-mod-3.1.4/test/data/subdir1/subdir2/0000755000000000000000000000000012243047510016034 5ustar0000000000000000ghc-mod-3.1.4/test/data/subdir1/subdir2/dummy0000644000000000000000000000000612243047510017106 0ustar0000000000000000dummy