pax_global_header00006660000000000000000000000064125344166560014526gustar00rootroot0000000000000052 comment=f9cebde64664c094e86cc34f5a1c38a1cd133f3d haskell-mode-13.14.2/000077500000000000000000000000001253441665600142435ustar00rootroot00000000000000haskell-mode-13.14.2/.gitignore000066400000000000000000000001161253441665600162310ustar00rootroot00000000000000*.elc *~ haskell-mode-autoloads.el haskell-mode.info haskell-mode.tmp.texi dirhaskell-mode-13.14.2/.travis.yml000066400000000000000000000027321253441665600163600ustar00rootroot00000000000000language: emacs-lisp env: matrix: - EMACS=emacs23 TARGET=check - EMACS=emacs24 TARGET=check - EMACS=emacs-snapshot TARGET=check - EMACS=emacs24 TARGET=deploy-manual global: - secure: "ejv1+ub/v+Hm/23fhp4zLAHT3HiCG+YdDHai57LDe4LfEZCeGz4i/6LazbPbwm58v2YuKvMcdNshebc1s4A293ARJryPyFfW/8kEe+3hQ+cDxunNdHfqcS8SyhcDG0mrv7dqiVAtMJqB8qZb0c161KeEM8nyhC0wyQ+EZ5qJnzM=" matrix: allow_failures: - env: - EMACS=emacs-snapshot install: - if [ "$EMACS" = "emacs23" ]; then sudo apt-get update -qq && sudo apt-get install -qq emacs23-gtk emacs23-el; fi - if [ "$EMACS" = "emacs24" ]; then sudo add-apt-repository -y ppa:cassou/emacs && sudo apt-get update -qq && sudo apt-get install -qq emacs24 emacs24-el; fi - if [ "$EMACS" = "emacs-snapshot" ]; then sudo add-apt-repository -y ppa:ubuntu-elisp/ppa && sudo apt-get update -qq && sudo apt-get install -qq emacs-snapshot && sudo apt-get install -qq emacs-snapshot-el; fi - if [ "$TARGET" = "deploy-manual" ]; then curl -O http://ftp.gnu.org/gnu/texinfo/texinfo-5.2.tar.xz; tar -xf texinfo-5.2.tar.xz; cd texinfo-5.2; ./configure; make; sudo make install; cd ..; fi script: lsb_release -a && $EMACS --version && make EMACS=$EMACS $TARGET notifications: email: false # Local Variables: # indent-tabs-mode: nil # coding: utf-8 # End: haskell-mode-13.14.2/CONTRIBUTING.md000066400000000000000000000022661253441665600165020ustar00rootroot00000000000000If you intend on submitting a pull request, whichever branch you choose to submit a pull request on, please ensure that it is properly rebased against master. This will ensure that the merge is clean and that you have checked that your contribution still works against the recent master. A typical workflow might be: Have a remote setup that we can pull proper changes from: $ git remote add haskell git://github.com/haskell/haskell-mode.git Start our topic branch: $ git branch my-topic-branch Hack hack hack! Once changes committed (c.f. [github commit message format](https://github.com/blog/926-shiny-new-commit-styles)), run git pull on master and try to rebase onto it to check whether your work is out of date. $ git commit -a -m "My topic done." $ git pull haskell master $ git checkout my-topic-branch $ git rebase master If there are any conflicts, resolve them. Push changes to your Github fork: $ git push origin my-topic-branch Make a pull request on Github for my-topic-branch. Pull request gets merged in. Pull from the official Github remote: $ git pull haskell master Delete your topic branch: $ git branch -D my-topic-branch I'm all done! haskell-mode-13.14.2/Makefile000066400000000000000000000111351253441665600157040ustar00rootroot00000000000000# # Note: Due to MELPA distributing directly from github source version # needs to be embedded in files as is without proprocessing. # # Version string is present in: # - Makefile # - haskell-mode.el # - haskell-mode.texi # # We should have a script that changes it everywhere it is needed and # syncs it with current git tag. # VERSION = 13.14.2 INSTALL_INFO = install-info # Use $EMACS environment variable if present, so that all of these are # equivalent: # # 1. export EMACS=/path/to/emacs && make # 2. EMACS=/path/to/emacs make # 3. make EMACS=/path/to/emacs # # This is particularly useful when EMACS is set in ~/.bash_profile # EMACS := $(shell echo "$${EMACS:-emacs}") EFLAGS = --eval "(add-to-list 'load-path (expand-file-name \"tests/compat\") 'append)" \ --eval "(when (< emacs-major-version 24) \ (setq byte-compile-warnings '(not cl-functions)))" \ --eval '(setq byte-compile-error-on-warn t)' BATCH = $(EMACS) $(EFLAGS) --batch -Q -L . ELFILES = \ ghc-core.el \ ghci-script-mode.el \ highlight-uses-mode.el \ haskell-align-imports.el \ haskell-bot.el \ haskell-cabal.el \ haskell-checkers.el \ haskell-collapse.el \ haskell-modules.el \ haskell-sandbox.el \ haskell-commands.el \ haskell-compat.el \ haskell-compile.el \ haskell-complete-module.el \ haskell-customize.el \ haskell-debug.el \ haskell-decl-scan.el \ haskell-doc.el \ haskell.el \ haskell-font-lock.el \ haskell-indentation.el \ haskell-indent.el \ haskell-interactive-mode.el \ haskell-load.el \ haskell-menu.el \ haskell-mode.el \ haskell-move-nested.el \ haskell-navigate-imports.el \ haskell-package.el \ haskell-presentation-mode.el \ haskell-process.el \ haskell-repl.el \ haskell-session.el \ haskell-simple-indent.el \ haskell-sort-imports.el \ haskell-string.el \ haskell-unicode-input-method.el \ haskell-utils.el \ inf-haskell.el ELCFILES = $(ELFILES:.el=.elc) AUTOLOADS = haskell-mode-autoloads.el PKG_DIST_FILES = $(ELFILES) logo.svg NEWS haskell-mode.info dir ELCHECKS=$(addprefix check-, $(ELFILES:.el=)) %.elc: %.el @$(BATCH) \ -f batch-byte-compile $*.el .PHONY: all compile info clean check $(ELCHECKS) elpa package check-emacs-version all: check-emacs-version compile $(AUTOLOADS) info check-emacs-version : @$(BATCH) --eval "(when (< emacs-major-version 24) \ (message \"Error: haskell-mode requires Emacs 23 or later\") \ (message \"Your version of Emacs is %s\" emacs-version) \ (message \"Found as '$(EMACS)'\") \ (message \"Use one of:\") \ (message \" 1. export EMACS=/path/to/emacs && make\") \ (message \" 2. EMACS=/path/to/emacs make\") \ (message \" 3. make EMACS=/path/to/emacs\") \ (kill-emacs 2))" compile: $(ELCFILES) $(ELCHECKS): check-%: %.el %.elc @$(BATCH) --eval '(when (check-declare-file "$*.el") (error "check-declare failed"))' @if [ -f "$(<:%.el=tests/%-tests.el)" ]; then \ $(BATCH) -l "$(<:%.el=tests/%-tests.el)" -f ert-run-tests-batch-and-exit; \ fi @echo "--" check: $(ELCHECKS) @echo "checks passed!" clean: $(RM) $(ELCFILES) $(AUTOLOADS) $(AUTOLOADS:.el=.elc) haskell-mode.info dir info: haskell-mode.info dir dir: haskell-mode.info $(INSTALL_INFO) --dir=$@ $< haskell-mode.info: doc/haskell-mode.texi LANG=en_US.UTF-8 $(MAKEINFO) $(MAKEINFO_FLAGS) -o $@ $< doc/haskell-mode.html: doc/haskell-mode.texi doc/haskell-mode.css LANG=en_US.UTF-8 $(MAKEINFO) $(MAKEINFO_FLAGS) --html --css-include=doc/haskell-mode.css --no-split -o $@ $< doc/html/index.html : doc/haskell-mode.texi if [ -e doc/html ]; then rm -r doc/html; fi LANG=en_US.UTF-8 $(MAKEINFO) $(MAKEINFO_FLAGS) --html \ --css-ref=haskell-mode.css \ -c AFTER_BODY_OPEN='
' \ -c EXTRA_HEAD='' \ -c SHOW_TITLE=0 \ -o doc/html $< doc/html/haskell-mode.css : doc/haskell-mode.css doc/html/index.html cp $< $@ doc/html/haskell-mode.svg : images/haskell-mode.svg doc/html/index.html cp $< $@ doc/html/haskell-mode-32x32.png : images/haskell-mode-32x32.png doc/html/index.html cp $< $@ doc/html : doc/html/index.html doc/html/haskell-mode.css doc/html/haskell-mode.svg doc/html/haskell-mode-32x32.png deploy-manual : doc/html cd doc && ./deploy-manual.sh $(AUTOLOADS): $(ELFILES) haskell-mode.elc $(BATCH) \ --eval '(setq make-backup-files nil)' \ --eval '(setq generated-autoload-file "$(CURDIR)/$@")' \ -f batch-update-autoloads "." haskell-mode-13.14.2/NEWS000066400000000000000000000366321253441665600147540ustar00rootroot00000000000000Haskell Mode NEWS -*- org -*- This file uses Org mode. Some useful (default) key-bindings: - Use "C-c C-n"/"C-c C-p" to jump to next/prev heading - Use "" to expand/collapse nodes - Use "" to cycle visibility of all nodes - Use "C-c C-o" to open links * Changes in 13.12 - Added haskell-bot.el - Added support for cabal repl build targets - Automatically add import lines via Hoogle - Automatically add package to cabal file - Added w3m-haddock.el - Added debugger mode - Added preliminary :present support - Added haskell-sort-imports - Added haskell-complete-module - Support if and multi-way if in indentation - Add support to generate tags on windows - Add haskell-language-extensions variable - Improve haskell-simple-indent mode - Improve test cases * Changes in 13.10 - Small fix for haskell-simple-indent: Certain indentation situations cause valname-string to be nil, which haskell-trim did not handle gracefully (naturally, since nil != ""). - Luke Hoersten's Shnippet merged in under snippets/. - haskell-presentation-mode is now a haskell-mode derived mode. - Small improvement to haskell-process-do-info (works on constructors now and underscored names). - Add haskell-indent-spaces configuration variable. - The command string to run cabal commands is slightly more configurable. See: C-h f haskell-process-do-cabal-format-string * Changes in 13.8 See also [[https://github.com/haskell/haskell-mode/compare/v13.07...v13.08][detailed Git history]]. - Make `haskell-simple-indent-mode' a proper minor mode with `SInd` as mode-line lighter - Support popular "λ> " prompt in inf-haskell by default - Hide internal `*print-haskell-mode*' buffers (used when `haskell-interactive-mode-eval-mode' is active) - Add tab-completion support for haskell-interactive-mode (requires `:complete' command support in GHCi) - Add support to `haskell-process-do-info` to perform `:browse!` query on module name when called on import statement line - `haskell-decl-scan-mode': - New customize group `haskell-decl-scan' - New flag `haskell-decl-scan-bindings-as-variables' for controlling whether to put value bindings into the "Variables" category. - New flag `haskell-decl-scan-add-to-menubar' for controlling whether to add "Declarations" menu entry to menu bar. - New manual section node `(haskell-mode)haskell-decl-scan-mode' - Add support for [[http://www.haskell.org/ghc/docs/latest/html/users_guide/syntax-extns.html#lambda-case][LambdaCase]] syntax extension to `haskell-indentation` - Change `haskell-indentation-mode' to never jump back a whole line when pressing DEL. The old behavior can be restored by setting `haskell-indentation-delete-backward-jump-line' to t - New convenience function `haskell-cabal-visit-file' for locating and visiting most likely `.cabal` file associated with current buffer - Add support for [[http://www.haskell.org/ghc/docs/latest/html/users_guide/syntax-extns.html#package-import][PackageImports]] and [[http://www.haskell.org/ghc/docs/latest/html/users_guide/syntax-extns.html#safe-imports-ext][SafeHaskell]] syntax extensions to `haskell-decl-scan-mode' parser - Add `turn-{on,off}-haskell-doc' commands as aliases for the existing `turn-{on,off}-haskell-doc-mode' commands - Add support for "cabal repl" process type to `haskell-interactive-mode' - Add new Haskell compilation sub-mode and associated `haskell-compile' command * Changes in 13.7 See also [[https://github.com/haskell/haskell-mode/compare/v13.06...v13.07][detailed Git history]]. - Convert NEWS (this file) to Org mode style and include NEWS file in package and add command for visiting NEWS file (M-x haskell-mode-view-news) - Officially drop support for versions prior to Emacs 23 - New work-in-progress Info manual for haskell-mode - Remove deprecated `haskell-{hugs,ghci}' modules - Font-locking changes: - Remove deprecated `turn-on-haskell-font-lock` function - Improve font-locking of type-signatures in presence of newlines - Use `font-lock-preprocessor-face' instead of the previously used `font-lock-warning-face` for CPP directives - Use `font-lock-warning-face` instead of the previously used `font-lock-preprocessor-face` for Git merge conflict annotations. - Improvements to `haskell-move-nested' module: - Add support for operating on active regions - New interactive commands `haskell-move-nested-{left,right}` which support numeric prefix arguments for controlling the amount of shifting to apply. - Add `haskell-unicode-input-method.el` to distribution (enable with `turn-on-haskell-unicode-input-method`) - Fix all byte-compilation warnings - Build-system: - For in-place installation, `haskell-site-file.el' is renamed to `haskell-mode-autoloads.el` - Auto-generate ELPA compatible README file by extracting header of haskell-mode.el - New "make check" target - Add Travis-CI build jobs for testing byte-compilation with multiple Emacs versions - Reorganize customize settings - Add new convenience function for browsing all Haskell Mode settings (M-x haskell-customize) - Add `:link' keywords pointing to the new Info manual - Add `:group' keywords to modes to make (M-x customize-mode) work - Create new customization groups `haskell-interactive' and `inferior-haskell' to clean up namespace - Create new customization group `ghc-core` containing the two new customization variables `ghc-core-program` and `ghc-core-program-args`. - Improvements to haskell-interactive-mode - Add support for deleting compile messages superseded by recompile/reloads (M-x customize-variable RET haskell-interactive-mode-delete-superseded-errors) - Fix `C-u M-x haskell-process-do-type` inserting bad signatures - Integrate with Emacs' `next-error` subsystem - Add "C-c C-f" binding to REPL keymap for enabling `next-error-follow-minor-mode' - Add support for `-ferror-spans`-style compile messages - Add `-ferror-spans` as default for `haskell-process-args-ghci` - Add optional argument to `haskell-session-{all,installed,project}-modules' to suppress session-creation. This is useful for yasnippet usage, see commit 517fd7e for an example. - Change default for `haskell-process-path-ghci` to a static "ghci" - Fix `haskell-interactive-switch` not selecting the REPL window - Make `*haskell-process-log*` buffer configurable (controlled via new `haskell-process-log` customize option) * Changes in 13.6 See also [[https://github.com/haskell/haskell-mode/compare/2_9_1...v13.06][detailed Git history]]. - Switch to new versioning scheme - Switch to MELPA/Marmalade based packaging - Cleanup/refactor build-system - Enhance `M-x haskell-version` to report more detailed versioning information - Make haskell-interactive-mode emulate comint/eshell history navigation (see commit 0e96843 for more details) - Improvements to haskell-interactive-mode - Improve killing/restarting haskell-interactive sessions - Improve directory prompting and resolution - Fix redundant-import suggest trigger to support qualified imports - Detect all abbreviations of an user-inputted ":quit" - Fix regexps for recent GHC 7.x compiler messages - Customizable commandline args for GHCi (M-x customize-variable RET haskell-process-args-ghci) - New command to load or reload via prefix argument (M-x haskell-process-load-or-reload) - Fix haskell-interactive-mode prompt detection - Add cabal-ghci as supported process mode - Add a customization option for the visibility of multi-line errors (M-x customize-variable RET haskell-interactive-mode-hide-multi-line-errors) - Add forward declarations to reduce Elisp bytecompile warnings - Improvements to `haskell-indentation` - Add support for the UnicodeSyntax tokens `→`, `←`, and `∷`. - Indent "=" following data/type/newtype declarations. - Align "->"/"→" arrows in types under "::"/"∷" - Make customizable whether "" deletes indentation too (via `haskell-indentation-delete-backward-indentation` and `haskell-indentation-delete-indentation`) - Properly indent 'rec' keyword, same as 'mdo' - Minor optimizations. - Add support for "'"-prefixed constructors (-> DataKinds) to font-locking - New experimental haskell session menu mode (M-x haskell-menu) - Various minor cleanups/fixes/improvements... * Changes in 2.9.1 See also [[https://github.com/haskell/haskell-mode/compare/2_9_0...2_9_1][detailed Git history]]. - Bugfix release adding missing autoload declaration * Changes in 2.9.0 See also [[https://github.com/haskell/haskell-mode/compare/2_8_0...2_9_0][detailed Git history]]. - This is the first release after haskell-mode was migrated to GitHub - New experimental `haskell-interactive-mode' module implementing a new REPL interaction mode for GHCi sessions to eventually replace the existing "inf-haskell" mode. - New `haskell-process-cabal' command for interaction with cabal-install - New `haskell-checkers' module - Update haskell-cabal-mode font-lock keywords - Improve scrolling of hoogle output (haskell-mode.el) - Derive `haskell-mode` from `prog-mode` for Emacs 24+ - Add new binding for "" to haskell-mode's keymap which unindents current line - New modules `haskell-navigate-imports`, `haskell-sort-imports' and `haskell-align-imports' for operating on module import lines in Haskell source code - Add new binding for "C-c C-." to haskell-mode's keymap to sort and realign Haskell module imports - Add new binding for "C-c i" to haskell-mode's keymap to jump back and forth from/to the current Haskell module's module import section. - New `inferior-haskell-kind' function for querying kind via GHCi's ":kind" - New `inferior-haskell-send-decl' for sending declarations to GHCi (bound to "C-x C-d" by default) - Add new `haskell-doc-use-inf-haskell` customization variable - Add support for bird-style literate haskell editing and a new related customization variable `haskell-indentation-birdtrack-extra-space' - Font locking improvements - Add support for Git's merge annotation (with `font-lock-preprocessor-face') - Improve `import', `foreign import' and `foreign export' font locking - Add support for `rec', `proc' and `mdo` as keywords - Make whitespace within `-- |' and `{- |' optional when possible - New `haskell-move-nested` module providing utilities for interactively {in,de}denting nested "hanging" blocks. - Add stylish-haskell support (enable via `haskell-stylish-on-save` customization variable) - Add support for generating tags on save (enable via `haskell-tags-on-save' customization variable) - Set sensible dabbrev defaults in haskell-mode - Added `SCC` pragma insert/delete commands (`haskell-mode-insert-scc-at-point` and `haskell-mode-kill-scc-at-point') - New experimental `haskell-mode-contextual-space' command - And a couple more cleanups/fixes/improvements... * Changes in 2.8.0 (since 2.7.0) See also [[https://github.com/haskell/haskell-mode/compare/2_7_0...2_8_0][detailed Git history]]. - Minimal indentation support for arrow syntax - Avoid opening a new inf-haskell window if one is already visible. Windows on other virtual desktops or iconified frames don't count. - Force comint-process-echoes to nil - Autolaunch haskell-mode for files starting with #!/usr/bin/runghc and similar - Added minimal major mode for parsing GHC core files, courtesy of Johan Tibell. There is a corresponding Haskell menu entry. - Allow configuration of where-clause indentation; M-x customize-group haskell-indentation. * Changes since 2.6.4 - fill-paragraph (M-q) now only affects comments, and correctly handles Haddock commentary. adaptive-fill-mode is turned off, as it was interfering. - Yet more unicode symbols - Better support for unicode encoding of haskell source files - mdo correctly indented - Indentation fixes, fixes to the fixes, and fixes to the fixes to the fixes - New command: M-x haskell-check, calls (by default) hlint on the current file. Also bound to C-c C-v. You can also use the flymake minor mode with this. * Changes since 2.5.1 - Parser corrections for haskell-indentation and haskell-decl-scan - haskell-indentation: Pressing tab in the rightmost position now moves to the leftmost, by default with a warning. - Typo fix: One haskell-indentation variable had ended up in the haskell-ntation customize group. - haskell-hoogle aliased to hoogle, haskell-hayoo aliased to hayoo - Courtesy of Alex Ott: - Additional unicode symbols for font-lock-symbols: () == /= >= <= !! && || sqrt - M-x haskell-hayoo search added, opens using browse-url - Bug-fix for inferior-haskell-type - If haskell-indentation errors out, it now fail-safes to inserting a literal newline or deleting one character, for return and backspace respectively. * Changes since 2.4: - haskell-indentation, a new minor mode for indentation. * Changes since 2.3: - Update license to GPLv3. - New derived major mode for .hsc files. - Removed the C-c C-r binding to reload a file. You can still call inferior-haskell-reload-file (and/or bind it to your favorite key, including C-c C-r) or you can now use C-u C-c C-l. - C-c C-d looks up the symbol at point in the Haddock docs. - Haddock comments are highlighted with font-lock-doc-face if it exists. - Use `tex' rather than `latex' for haskell-literate. - inf-haskell.el tries to find the root of the module hierarchy to determine the root of a project (either by looking for a Cabal file or relying on the `module' declaration line). If all works well, this will make C-c C-l automatically switch to the root dir, so that dependencies in other directories are automatically found. If it doesn't, complain and/or set inferior-haskell-find-project-root to nil. - The new command haskell-hoogle helps you query Hoogle from Emacs. * Changes since 2.2: - Trivial support for Cabal package description files. - Minor bug fixes. * Changes since 2.1: - There are now commands to find type and info of identifiers by querying an inferior haskell process. Available under C-c C-t, C-c C-i, and C-c M-. - Indentation now looks back further, until a line that has no indentation. To recover the earlier behavior of stopping at the first empty line instead, configure haskell-indent-look-past-empty-line. - inf-haskell can wait until a file load completes and jump directly to the first error, like haskell-ghci and haskell-hugs used to do. See the var inferior-haskell-wait-and-jump. * Changes since 2.0: - inf-haskell uses ghci if hugs is absent. - Fix up some binding conflicts (C-c C-o in haskell-doc) - Many (hopefully minor) changes to the indentation. - New symbols in haskell-font-lock-symbols-alist. * Changes since 1.45: - keybindings C-c have been replaced by C-c C- so as not to collide with minor modes. - The following modules are now automatically activated without having to add anything to haskell-mode-hook: haskell-font-lock (just turn on global-font-lock-mode). haskell-decl-scan (just bind `imenu' to some key). - In recent Emacsen, haskell-doc hooks into eldoc-mode. - haskell-hugs and haskell-ghci are superceded by inf-haskell. - Indentation rules have been improved when using layout inside parens/braces. - Symbols like -> and \ can be displayed as actual arrows and lambdas. See haskell-font-lock-symbols. - Tweaks to the font-lock settings. Among other things paren-matching with things like \(x,y) should work correctly now. - New maintainer . haskell-mode-13.14.2/README.md000066400000000000000000000074651253441665600155360ustar00rootroot00000000000000![Haskell Mode Logo](images/haskell-mode-128x128.png) Haskell Mode for Emacs ====================== This is an Emacs mode for editing, debugging and developing Haskell programs. [![Build Status](https://travis-ci.org/haskell/haskell-mode.svg?branch=master)](https://travis-ci.org/haskell/haskell-mode) [![Melpa Status](http://melpa.org/packages/haskell-mode-badge.svg)](http://melpa.org/#/haskell-mode) [![Melpa Stable Status](http://stable.melpa.org/packages/haskell-mode-badge.svg)](http://stable.melpa.org/#/haskell-mode) ## Installation `haskell-mode` is best installed as a package. To install `haskell-mode` you need to add a package archive repository that distributes `haskell-mode`. Execute ``` M-x customize-option RET package-archives ``` and add Archive name: melpa-stable URL or directory name: http://stable.melpa.org/packages/ Fetch list of packages with M-x package-refresh-contents and then follow by M-x package-install RET haskell-mode Voila! `haskell-mode` is installed! You should be able to edit Haskell source code in color now. You need to enable indentation as this does not happen automatically currently. Add this line to your ~/.emacs file: ```el (add-hook 'haskell-mode-hook 'haskell-indentation-mode) ``` `Haskell-mode` has much much much more to offer but the above should get you going! ## Advanced configuration For setup instructions, please consult the integrated `haskell-mode` [Info](https://www.gnu.org/software/texinfo/manual/info/info.html) manual which can be accessed after installation via `M-x info-display-manual [RET] haskell-mode`. Alternatively, you can also direct your browser to the [the online haskell-mode manual](https://github.com/haskell/haskell-mode/wiki) for setup and user guide. ## Installation - more information `haskell-mode` supports GNU Emacs versions 23, 24 and upcoming 25 (snapshot). `haskell-mode` is available from [melpa-stable](http://stable.melpa.org) (releases) and [melpa](http://melpa.org) (git snapshots). Other means of obtaining `haskell-mode` include [el-get](https://github.com/dimitri/el-get), [Emacs Prelude](https://github.com/bbatsov/prelude) and [Debian package](https://packages.debian.org/search?keywords=haskell-mode). Emacs23 requires an the use of "cl-lib". cl-lib.el can be found in the tests/compat directory. Copy cl-lib.el to your emacs directory, e.g. ~/.emacs.d directory and put ```el (add-to-list 'load-path "~/.emacs.d/") (require 'cl-lib) ``` in your .emacs file. ## Installation from git repository Running `haskell-mode` directly from sources is easy but requires a little preparation: - `git clone https://github.com/haskell/haskell-mode.git` into a suitable directory, e.g. `~/lib/emacs/haskell-mode/` where `~` stands for your home directory. - Assuming you have unpacked the various haskell-mode modules (`haskell-mode.el` and the rest) in the directory `~/lib/emacs/haskell-mode/`, you need to generate various files, the autoloads file (`haskell-mode-autoloads.el`) is one among them. Invoke: ```bash make EMACS=/path/to/your/emacs ``` and then adding the following command to your `.emacs`: ```el (add-to-list 'load-path "~/lib/emacs/haskell-mode/") (require 'haskell-mode-autoloads) (add-to-list 'Info-default-directory-list "~/lib/emacs/haskell-mode/") ``` ## Contributing If you followed the above you are just a couple of steps away from contributing to `haskell-mode`. `haskell-mode` is activelly seeking contributions from users of `haskell-mode`. For more information have a look at [the wiki page on contributing](https://github.com/haskell/haskell-mode/wiki/Contributing). ## Getting in contact - [Mailing list](http://projects.haskell.org/cgi-bin/mailman/listinfo/haskellmode-emacs) - [Github homepage](https://github.com/haskell/haskell-mode) - IRC: #haskell-emacs on irc.freenode.net Have fun! haskell-mode-13.14.2/doc/000077500000000000000000000000001253441665600150105ustar00rootroot00000000000000haskell-mode-13.14.2/doc/deploy-manual.sh000077500000000000000000000033051253441665600201170ustar00rootroot00000000000000#!/bin/bash set -e set -u if [[ "${TRAVIS_REPO_SLUG:-}" != "haskell/haskell-mode" ]]; then echo "TRAVIS_REPO_SLUG is '${TRAVIS_REPO_SLUG:-}' expected 'haskell/haskell-mode'" echo "Manual deployment available only directly for 'haskell/haskell-mode' repo" exit 0 fi if [[ "${TRAVIS_BRANCH:-}" != "master" ]]; then echo "TRAVIS_BRANCH is '${TRAVIS_BRANCH:-}' expected 'master'" echo "Manual deployment available only for 'master' branch" exit 0 fi if [[ -z "${GITHUB_DEPLOY_KEY_PASSPHRASE:-}" ]]; then echo "GITHUB_DEPLOY_KEY_PASSPHRASE must be set to passphrase for github deploy key" echo "Pull requests do not have access to secure variables" exit 0 fi # Note: GITHUB_DEPLOY_KEY_PASSPHRASE comes from 'secure' section in .travis.yml cp haskell-mode-travis-deploy-key haskell-mode-travis-deploy-key-plain chmod 0600 haskell-mode-travis-deploy-key-plain ssh-keygen -f haskell-mode-travis-deploy-key-plain -P $GITHUB_DEPLOY_KEY_PASSPHRASE -p -N "" eval $(ssh-agent) ssh-add haskell-mode-travis-deploy-key-plain # Git setup, this commit should appear as if Travis made it export GIT_COMMITTER_EMAIL='travis@travis-ci.org' export GIT_COMMITTER_NAME='Travis CI' export GIT_AUTHOR_EMAIL='travis@travis-ci.org' export GIT_AUTHOR_NAME='Travis CI' HEAD_COMMIT=$(git rev-parse --short HEAD) if [ -d gh-pages-deploy ]; then rm -fr gh-pages-deploy fi git clone --quiet --branch=gh-pages "git@github.com:haskell/haskell-mode.git" gh-pages-deploy cd gh-pages-deploy git rm -qr manual/latest cp -r ../html manual/latest git add manual/latest (git commit -m "Update manual from haskell/haskell-mode@${HEAD_COMMIT}" && git push) || true cd .. rm -fr gh-pages-deploy eval $(ssh-agent -k) echo Done! haskell-mode-13.14.2/doc/haskell-mode-travis-deploy-key000066400000000000000000000033461253441665600226740ustar00rootroot00000000000000-----BEGIN RSA PRIVATE KEY----- Proc-Type: 4,ENCRYPTED DEK-Info: AES-128-CBC,9385B3F19E12C488ACF654D37A7B70B2 3ucmv5i37lwRejeFWTliQ9pfs8Vfq1G/30lnI7/GroClDiE2LAKm9tWzD8EAVdjx lAcD9gKy9g+5Gft/qj+ucXmh2OWhTz2veBIJzjuujoZBNbbgBhBGrkAzr0h2LK5u OE06F5Goz6rAjnyFbxTU9slZnWENHKpnwYBRriIq3KM1vS9Kr/0S3cYYfY5exITT Gy5uTLHDVzps5Bn7wjLgXRUoLbDRRDF6L4LPkaFyEHRt+1VjtqWc3jnMuY7P2Rru y8Mlr0cv9UzeJleTrN8AvcEtUCcl7FpieSZsGh0Q2/wEj3fEFk6Zf/q3aAqz0mn4 hdp3CvTRUeYv1JibdXSptd34dpxB+9IJIbZnZ4ixaj5Ay3oCj9PPHC+qDGsjeA6J ect9EzxuVr6j4gvJYR0nOKNH1KOBOAZDhCQG0kvZxXaQyUbu5NV+kh6XUCedzfJZ XyutuOF6frUjEkJlRj5aWdgtXUDKrPDO9jnV9jknoyaOQMjWt4vd8uhkWZo+SfZ8 bVO8pcx/YxNBKiHeDiLVUPc7h0Y1fI48RwLky+iLrYTe6hhMOPb8/PxZsbG+xVN5 +D2v08EhDzomxsPKBagHCb9Dffihi21F54ZeRBAx4Fr7O3KEHFE/67Oec5lz/seh yDw+ZhW9bLklO8nZWw4rJGKG7pCgb4pRVD4Rk3VFgVdolq9Z44YNCyHX+CsfuE7D KvHBOQWdpVD8EvP2sjqb7kIFOY9ZP5vOOZ10fm9XweCca4xJzwlr9aah0XXYza8S hCgkPYDQndLM4NH0UfGJPft7HhjUSF7vodL/0jKsTvRBeXnh5pgeTM576LnpfYd3 wzLKg4g2/bIMUGYKo4VRY6rXvQbf4MDvUlnGRMBnihbm+x0LU6U0/nxBzeKnv5D9 VR56xGwJHxIytNjqzAZVPk8+9nXw8Dyc0XmSkPsaYr5DgI/nacRbdvlVo2M8Rac8 72qcAqkUAB/JXl4Jbucw4nGBsdOnl6zGRqTMeG/bfR9ULM4u1wGzNeXghc5+Krk3 mMiZeCxfnAdw2eEM0aXieMD2QB882Cm5HVB+7tqQZcbpr8pt9uNQrr44rkBnNsqa LQdmbUN+1+uDXlFstkKBCN/i2cEX5NTo7yiebMZZ9/+uY1LWTPzV3wAwtJeYaMIB oJ5DunlxqpKULX8jL0k2qAuA57ah2DlsMj/2L9uNs84ZmkPnhtPpiDwsFCL+xxRo Sup6qrrBOP6WvGR8O4uWcKP/HH6x11cgD20NWcoSjslXBgJK5nV9uqiKE/vNjG9e /pDfvce4kdUQcp4hbJu+o8MrWLC9o3ijPZWfqikCt5dX8qMp364GZcyxYOy0gv9X g259f1GImJHcFMb88qqYdP9au+S96ZIXOGtlKH/nwfe/UFe9tO2jOQqNgVh+Akyu 3gcjuMyDQryXNNHMRlB76mFAUnSUQIQ3n84oMFn8ZscogDdA89FWOV0MUkSoiVmW 7uD2hlliYg269xDJH3FE4Txk95fKquJpsa+6hzpt2V7VqR6m0BzQ+yQmMFuWsLtI oTOUtdPYojZVWPgeskNCrxEg2/CJQ4lHGQhv8tab5HWleHCS75RjwlFpYE9Ie4K3 -----END RSA PRIVATE KEY----- haskell-mode-13.14.2/doc/haskell-mode.css000066400000000000000000000025611253441665600200730ustar00rootroot00000000000000@charset "UTF-8"; @import url("http://fonts.googleapis.com/css?family=Lato:400,400italic,700,700italic&subset=latin,latin-ext"); @import url("http://fonts.googleapis.com/css?family=Source Code Pro"); body {font-family: Lato, Arial, sans-serif; font-feature-settings: "kern", "liga", "clig", "calt"; font-size: 14pt; line-height: 1.35; } body {width: 800px; margin: 0 auto;} table.menu {width: 700px; margin-left: 50px; } /* makeinfo 5.2 */ div.header p {margin: 0; text-align: right;} div.header {background-color: #9a98bd; background: linear-gradient(#CDCCDE,#A9A7CD);} /* makeinfo 4.8 */ div.node {background-color: #9a98bd; background: linear-gradient(#CDCCDE,#A9A7CD);} div.node p {margin: 0; text-align: right;} div.node hr {margin: 0;} div.footnote h3 {display: inline; font-size: normal;} /* makeinfo up to 5.2 cannot pass on unicode characters without messing them up */ a[rel="up"]:before {content: " \2191 "; /* ↑ */} a[rel="prev"]:before {content: " \2190 "; /* ← */} a[rel="next"]:before {content: " \2192 "; /* → */} code, kbd, samp, pre { font-family: "Source Code Pro", Menlo, Inconsolata, monospace;} kbd {font-style:normal} div.background { position: fixed; right: 30px; bottom: 0px; width: 256px; height: 256px; opacity: 0.3; background-image: url("haskell-mode.svg"); background-repeat: no-repeat; background-size: 256px 256px; } haskell-mode-13.14.2/doc/haskell-mode.texi000066400000000000000000000525521253441665600202610ustar00rootroot00000000000000\input texinfo @c -*-texinfo-*- @c %**start of header @setfilename haskell-mode.info @documentencoding UTF-8 @settitle Haskell Mode 13.14.1 @c %**end of header @dircategory Emacs @direntry * Haskell Mode: (haskell-mode). Haskell Development Environment for Emacs(en) @end direntry @copying This manual is for Haskell mode, version 13.14.2 Copyright @copyright{} 2013 Haskell Mode contributors. @quotation Permission is granted to copy, distribute and/or modify this document under the terms of the @uref{http://www.gnu.org/licenses/fdl.html,GNU Free Documentation License}, Version 1.3 or any later version published by the Free Software Foundation; with no Invariant Sections, no Front-Cover Texts and no Back-Cover Texts. @end quotation @end copying @iftex @titlepage @title Haskell Mode @subtitle Haskell Development Environment for Emacs @page @vskip 0pt plus 1filll @insertcopying @end titlepage @contents @end iftex @ifnottex @node Top @top Haskell Mode Haskell Mode is an Haskell development Environment for GNU Emacs version 23 or later. It provides syntax-based indentation, font locking, editing cabal files, and supports running an inferior Haskell interpreter (e.g. GHCi). @end ifnottex @menu * Introduction:: An introduction to Haskell Mode * Getting Help and Reporting Bugs:: How to improve Haskell Mode * Getting Started:: How to get started * Editing Haskell Code:: How to edit code * Unicode support:: How to use Unicode * Indentation:: Notes about indentation * Declaration scanning:: How to navigate in a source file * Compilation:: How to compile * Inferior Haskell interpreter:: How to interact with GHCi (1) * Interactive Haskell:: How to interact with GHCi (2) * Editing Cabal files:: Cabal support * Concept index:: Index of Haskell Mode concepts * Function index:: index of commands * Variable index:: Index of options and types @end menu @ifhtml @insertcopying @end ifhtml @node Introduction @chapter Introduction @dfn{Haskell Mode} is a major mode providing a convenient environment for editing @uref{http://www.haskell.org,Haskell} programs. Some of its major features are: @itemize @item Syntax highlighting (font lock), @item automatic indentation, @item on-the-fly documentation, @item interaction with inferior GHCi/Hugs instance, and @item scanning declarations and placing them in a menu. @end itemize @node Getting Help and Reporting Bugs @chapter Getting Help and Reporting Bugs This Info manual is work in progress and incomplete. However, you can find more information at these locations in the meantime: @itemize @item @uref{https://github.com/haskell/haskell-mode,Haskell Mode's GitHub Home} @item @uref{http://www.haskell.org/haskellwiki/Haskell_mode_for_Emacs,Haskell Wiki Emacs Page} @end itemize If you have any questions or like to discuss something regarding Haskell Mode, please consider sending an email to the @uref{http://projects.haskell.org/cgi-bin/mailman/listinfo/haskellmode-emacs, Haskellmode-emacs mailing list}. The mailing list is also available on @uref{http://gmane.org/, Gmane} via the @uref{http://dir.gmane.org/gmane.comp.lang.haskell.emacs, gmane.comp.lang.haskell.emacs} newsgroup. If you have discovered a bug or wish to request a new feature, you can @uref{https://github.com/haskell/haskell-mode/issues/new, file a new issue} with Haskell Mode's issue tracker. When filing a bug, please state your currently used software version (@kbd{M-x haskell-version}, @kbd{M-x version}) and what steps to perform in order to reproduce the bug you're experiencing. Finally, if you happen to be proficient in @ref{Top,Emacs Lisp,,elisp} you are welcome to submit patches via @uref{https://help.github.com/articles/using-pull-requests, GitHub Pull Requests}. @node Getting Started @chapter Getting Started If you are reading this, you have most likely already managed to install Haskell Mode in one way or another. @findex haskell-customize Most of Haskell Mode's settings are configurable via customizable variables (@pxref{Easy Customization,,,emacs}, for details). You can use @kbd{M-x haskell-customize} to browse the @code{haskell} customization sub-tree. @vindex haskell-mode-hook One of the important setting you should customize is the @code{haskell-mode-hook} variable (@pxref{Hooks,,,emacs}) which gets run right after the @code{haskell-mode} major mode is initialized for a buffer. You can customize @code{haskell-mode-hook} by @kbd{M-x customize-variable @key{RET} haskell-mode-hook}. It's highly recommended you set up indentation to match your preferences; @xref{Indentation}, for more details about the indentation modes included with Haskell Mode. @c TODO: @c provide basic instructions to get up and running with haskell-mode @c tell about the most important commands @node Editing Haskell Code @chapter Editing Haskell Code @findex haskell-mode @cindex @code{haskell-mode} @dfn{Haskell Mode} is actually a collection of so-called major modes@footnote{for more information about the concept of @dfn{major modes} @pxref{Major Modes,,,emacs}} one of which is called @code{haskell-mode}. To avoid confusion, when referring to this package the name ``Haskell mode'' is written in a normal font, whereas when referring the major mode of the same name @code{haskell-mode} written with a dash in-between in a typewriter font is used. As one might guess, @code{haskell-mode} is the (programming language@footnote{@code{haskell-mode} is derived from @code{prog-mode}}) major mode for editing (non-literate) Haskell source code. @code{haskell-mode} is associated with the file extensions listed below by default@footnote{for more information about file associations, @pxref{Choosing Modes,,,emacs}}. @table @file @item .hs official file extension for (non-literate) Haskell 98/2010 files @item .hsc ``almost-Haskell'' input file for the @uref{http://www.haskell.org/ghc/docs/latest/html/users_guide/hsc2hs.html,hsc2hs} pre-processor @item .cpphs input file for the @uref{http://projects.haskell.org/cpphs/,cpphs} pre-processor @end table @cindex literate programming @findex literate-haskell-mode @noindent The major mode @code{literate-haskell-mode} (which is derived from @code{haskell-mode} and thus transitively from @code{prog-mode}) provides support for @uref{http://www.haskell.org/haskellwiki/Literate_programming,literate Haskell programs} and is associated with the @file{.lhs} file extension by default. @code{literate-haskell-mode} supports Bird-style as well as @TeX{}-style literate Haskell files. The currently detected literate Haskell variant is shown in the mode line (@pxref{Mode Line,,,emacs}) as either @samp{LitHaskell/bird} or @samp{LitHaskell/tex}. @section Font Lock Support @code{haskell-mode} supports @dfn{syntax highlighting} via Emacs' Font Lock minor mode which should be enabled by default in current Emacsen. @xref{Font Lock,,,emacs}, for more information on how to control @code{font-lock-mode}. @node Unicode support @chapter Unicode support @cindex Unicode See the Haskell Wiki's entry on @uref{http://www.haskell.org/haskellwiki/Unicode-symbols, Unicode Symbols} for general information about Unicode support in Haskell. As Emacs supports editing files containing Unicode out of the box, so does Haskell Mode. As an add-on, Haskell Mode includes the @code{haskell-unicode} input method which allows you to easily type a number of Unicode symbols that are useful when writing Haskell code; @xref{Input Methods,,,emacs}, for more details. To automatically enable the @code{haskell-unicode} input method in haskell-mode buffers use @kbd{M-x customize-variable @key{RET} haskell-mode-hook} or put the following code in your @file{.emacs} file: @lisp (add-hook 'haskell-mode-hook 'turn-on-haskell-unicode-input-method) @end lisp @noindent To temporarily enable this input method for a single buffer you can use @kbd{M-x turn-on-haskell-unicode-input-method}. When the @code{haskell-unicode} input method is active, you can simply type @samp{->} and it is immediately replaced with @samp{→}. Use @kbd{C-\} to toggle the input method. To see a table of all key sequences use @kbd{M-x describe-input-method @key{RET} haskell-unicode}. A sequence like @samp{<=} is ambiguous and can mean either @samp{⇐} or @samp{≤}. Typing it presents you with a choice. Type @kbd{1} or @kbd{2} to select an option or keep typing to use the default option. If you don't like the highlighting of partially matching tokens you can turn it off by setting @code{input-method-highlight-flag} to @code{nil} via @kbd{M-x customize-variable}. @node Indentation @chapter Indentation @cindex indentation @cindex layout rule @cindex off-side rule For general information about indentation support in GNU Emacs, @pxref{Indentation,,,emacs}. In Haskell, code indentation has semantic meaning as it defines the block structure@footnote{Haskell also supports braces and semicolons notation for conveying the block structure. However, most Haskell programs written by humans use indentation for block structuring.}. As GNU Emacs' default indentation function (i.e. @code{indent-relative}) is not designed for use with Haskell's layout rule, Haskell mode includes three different indentation minor modes with different trade-offs: @ftable @code @item turn-on-haskell-simple-indent A very simple indentation scheme; In this scheme, @key{TAB} will now move the cursor to the next indent point in the previous non-blank line. An indent point is a non-whitespace character following whitespace. @item turn-on-haskell-indent Intelligent semi-automatic indentation for Haskell's layout rule. The basic idea is to have @key{TAB} cycle through possibilities indentation points based on some clever heuristics. The rationale and the implementation principles are described in more detail in the article @cite{Dynamic tabbing for automatic indentation with the layout rule} published in the Journal of Functional Programming 8.5 (1998). @item turn-on-haskell-indentation Improved variation of @code{turn-on-haskell-indent} indentation mode. Rebinds @key{RET} and @key{DEL}, so that indentations can be set and deleted as if they were real tabs. @end ftable To enable one of these three mutually exclusive indentation schemes, you just need call one (and only one!) of the @code{turn-on-*} commands while in the buffer you want the indentation scheme to be activated for. The recommended way is to add one of @code{turn-on-*} commands to @code{haskell-mode-hook}. This can be done either by using @kbd{M-x customize-variable @key{RET} haskell-mode-hook} which provides a convenient user interface or by adding @emph{one} of the following three lines to your @file{.emacs} file: @lisp (add-hook 'haskell-mode-hook 'turn-on-haskell-simple-indent) (add-hook 'haskell-mode-hook 'turn-on-haskell-indent) (add-hook 'haskell-mode-hook 'turn-on-haskell-indentation) @end lisp @section Interactive Block Indentation By inserting the key bindings for @kbd{C-,} and @kbd{C-.} (these bindings are convenient on keyboard layouts where @key{,} and @key{.} are adjacent keys) as shown below you can interactively de/indent either the following nested block or, if a region is active while in Transient Mark Mode (@pxref{Disabled Transient Mark,,,emacs}), de/indent the active region. By using a numeric prefix argument (@pxref{Prefix Command Arguments,,,elisp}) you can modify the shift-amount; for instance, @kbd{C-u C-,} increases indentation by 4 characters at once. @findex haskell-move-nested-left @findex haskell-move-nested-right @lisp (eval-after-load "haskell-mode" '(progn (define-key haskell-mode-map (kbd "C-,") 'haskell-move-nested-left) (define-key haskell-mode-map (kbd "C-.") 'haskell-move-nested-right))) @end lisp @section Rectangle Commands @cindex rectangle @cindex CUA mode GNU Emacs provides so-called @dfn{rectangle commands} which operate on rectangular areas of text, which are particularly useful for languages with a layout rule such as Haskell. @xref{Rectangles,,,emacs}, to learn more about rectangle commands. Moreover, CUA mode (@pxref{CUA Bindings,,,emacs}) provides enhanced rectangle support with visible rectangle highlighting. When CUA mode is active, you can initiate a rectangle selection by @kbd{C-RET} and extend it simply by movement commands. You don't have to enable full CUA mode to benefit from these enhanced rectangle commands; you can activate CUA selection mode (without redefining @kbd{C-x},@kbd{C-c},@kbd{C-v}, and @kbd{C-z}) by calling @kbd{M-x cua-selection-mode} (or adding @code{(cua-selection-mode nil)} to your @code{haskell-mode-hook}). @node Declaration scanning @chapter Declaration scannning @findex turn-on-haskell-decl-scan @findex haskell-decl-scan-mode @vindex haskell-decl-scan-mode-hook @code{haskell-decl-scan-mode} is a minor mode which performs declaration scanning and provides @kbd{M-x imenu} support (@pxref{Imenu,,,emacs} for more information). For non-literate and @TeX{}-style literate scripts, the common convention that top-level declarations start at the first column is assumed. For Bird-style literate scripts, the common convention that top-level declarations start at the third column, ie. after @samp{> }, is assumed. When @code{haskell-decl-scan-mode} is active, the standard Emacs top-level definition movement commands (@pxref{Moving by Defuns,,,emacs}) are enabled to operate on Haskell declarations: @table @kbd @item C-M-a Move to beginning of current or preceding declaration (@code{beginning-of-defun}). @item C-M-e Move to end of current or following declaration (@code{end-of-defun}). @item C-M-h Select whole current or following declaration (@code{mark-defun}). @end table Moreover, if enabled via the option @code{haskell-decl-scan-add-to-menubar}, a menu item ``Declarations'' is added to the menu bar listing the scanned declarations and allowing to jump to declarations in the source buffer. It's recommended to have font lock mode enabled (@pxref{Font Lock,,,emacs}) as @code{haskell-decl-scan-mode} ignores text highlighted with @code{font-lock-comment-face}. As usual, in order to activate @code{haskell-decl-scan-mode} automatically for Haskell buffers, add @code{turn-on-haskell-decl-scan} to @code{haskell-mode-hook}: @lisp (add-hook 'haskell-mode-hook 'turn-on-haskell-decl-scan) @end lisp @code{haskell-decl-scan-mode} enables the use of features that build upon @code{imenu} support such as Speedbar Frames (@pxref{Speedbar,,,emacs}) or the global ``Which Function'' minor mode (@pxref{Which Function,,,emacs}). In order to enable @code{which-function-mode} for Haskell buffers you need to add the following to your Emacs initialization: @lisp (eval-after-load "which-func" '(add-to-list 'which-func-modes 'haskell-mode)) @end lisp @node Compilation @chapter Compilation @findex haskell-compile Haskell mode comes equipped with a specialized @dfn{Compilation mode} tailored to GHC's compiler messages with optional support for Cabal projects. @xref{Compilation Mode,,,emacs}, for more information about the basic commands provided by the Compilation mode which are available in the Haskell compilation sub-mode as well. The additional features provided compared to Emacs' basic Compilation mode are: @itemize @item DWIM-style auto-detection of compile command (including support for CABAL projects) @item Support for GHC's compile messages and recognizing error, warning and info source locations (including @option{-ferror-spans} syntax) @item Support for filtering out GHC's uninteresting @samp{Loading package...} linker messages @end itemize In order to use it, invoke the @code{haskell-compile} command instead of @code{compile} as you would for the ordinary Compilation mode. It's recommended to bind @code{haskell-compile} to a convenient key binding. For instance, you can add the following to your Emacs initialization to bind @code{haskell-compile} to @kbd{C-c C-c}. @lisp (eval-after-load "haskell-mode" '(define-key haskell-mode-map (kbd "C-c C-c") 'haskell-compile)) (eval-after-load "haskell-cabal" '(define-key haskell-cabal-mode-map (kbd "C-c C-c") 'haskell-compile)) @end lisp @noindent The following description assumes that @code{haskell-compile} has been bound to @kbd{C-c C-c}. @vindex haskell-compile-cabal-build-command @vindex haskell-compile-cabal-build-command-alt @vindex haskell-compile-command When invoked, @code{haskell-compile} tries to guess how to compile the Haskell program your currently visited buffer belongs to, by searching for a @file{.cabal} file in the current of enclosing parent folders. If a @file{.cabal} file was found, the command defined in the @code{haskell-compile-cabal-build-command} option is used. Moreover, when requesting to compile a @file{.cabal}-file is detected and a negative prefix argument (e.g. @kbd{C-- C-c C-c}) was given, the alternative @code{haskell-compile-cabal-build-command-alt} is invoked. By default, @code{haskell-compile-cabal-build-command-alt} contains a @samp{cabal clean -s} command in order to force a full rebuild. Otherwise if no @file{.cabal} could be found, a single-module compilation is assumed and @code{haskell-compile-command} is used (@emph{if} the currently visited buffer contains Haskell source code). You can also inspect and modify the compile command to be invoked temporarily by invoking @code{haskell-compile} with a prefix argument (e.g. @kbd{C-u C-c C-c}). If later-on you want to recompile using the same customized compile command, invoke @code{recompile} (bound to @kbd{g}) inside the @samp{*haskell-compilation*} buffer. @node Inferior Haskell interpreter @chapter Inferior Haskell interpreter @findex inferior-haskell-find-definition @findex inferior-haskell-find-haddock @findex inferior-haskell-info @findex inferior-haskell-load-and-run @findex inferior-haskell-load-file @findex inferior-haskell-mode @findex inferior-haskell-reload-file @findex inferior-haskell-start-process @findex inferior-haskell-type @vindex haskell-program-name @vindex inferior-haskell-mode-hook The major mode @code{inferior-haskell-mode} provides support for interacting with an inferior Haskell process based on @code{comint-mode}. By default the @code{haskell-mode-map} keymap is setup to use this mode: @table @kbd @item C-c C-z is bound to @code{switch-to-haskell} @item C-c C-b is bound to @code{switch-to-haskell} @item C-c C-l is bound to @code{inferior-haskell-load-file} @item C-c C-t is bound to @code{inferior-haskell-type} @item C-c C-i is bound to @code{inferior-haskell-info} @end table The Haskell interpreter used by the inferior Haskell mode is auto-detected by default, but is customizable via the @code{haskell-program-name} variable. Currently, GHCi and Hugs are support as Haskell interpreter. TODO/WRITEME @c write about supported features @node Interactive Haskell @chapter Interactive Haskell An alternative mode providing a @acronym{REPL,read–eval–print loop} via GHCi sessions is called @code{haskell-interactive-mode}, which effectively replaces @code{inferior-haskell-mode}, but comes with a different set of features: @itemize @item Separate sessions per Cabal project @file{haskell-session.el}. @item A new inferior Haskell process handling code @file{haskell-process.el}. @item New REPL implementation similiar to SLIME/IELM @file{haskell-interactive-mode.el}. @end itemize In order to use @code{haskell-interactive-mode} instead of the default @code{inferior-haskell-mode}, you need to replace some of the default keybindings in the @code{haskell-mode-map} keymap with the respective @code{haskell-interactive-mode} counterparts: @lisp (eval-after-load "haskell-mode" '(progn (define-key haskell-mode-map (kbd "C-x C-d") nil) (define-key haskell-mode-map (kbd "C-c C-z") 'haskell-interactive-switch) (define-key haskell-mode-map (kbd "C-c C-l") 'haskell-process-load-file) (define-key haskell-mode-map (kbd "C-c C-b") 'haskell-interactive-switch) (define-key haskell-mode-map (kbd "C-c C-t") 'haskell-process-do-type) (define-key haskell-mode-map (kbd "C-c C-i") 'haskell-process-do-info) (define-key haskell-mode-map (kbd "C-c M-.") nil) (define-key haskell-mode-map (kbd "C-c C-d") nil))) @end lisp With @code{haskell-interactive-mode}, each Haskell source buffer is associated with at most one GHCi session, so when you call @code{haskell-process-load-file} for a Haskell source buffer which has no session associated yet, you're asked which GHCi session to create or associate with. TODO/WRITEME @node Editing Cabal files @chapter Editing Cabal files @findex haskell-cabal-mode @vindex haskell-cabal-mode-hook @code{haskell-cabal-mode} is a major mode for editing @uref{http://www.haskell.org/cabal/users-guide/developing-packages.html,Cabal package description files} and is automatically associated with files having a @file{.cabal} extension. @findex haskell-cabal-visit-file For quickly locating and jumping to the nearest @file{.cabal} file from a Haskell source buffer, you can use @kbd{M-x haskell-cabal-visit-file}; with a prefix argument (i.e. @kbd{C-u}) @code{find-file-other-window} is used to visit the @file{.cabal} file. If you wish, you can bind @code{haskell-cabal-visit-file} to a convenient key sequence, e.g. @lisp (eval-after-load "haskell-mode" '(define-key haskell-mode-map (kbd "C-c v c") 'haskell-cabal-visit-file)) @end lisp TODO/WRITEME @node Concept index @unnumbered Concept index @printindex cp @node Function index @unnumbered Function index @printindex fn @node Variable index @unnumbered Variable index @printindex vr @bye @c Local Variables: @c End: haskell-mode-13.14.2/ghc-core.el000066400000000000000000000076721253441665600162700ustar00rootroot00000000000000;;; ghc-core.el --- Syntax highlighting module for GHC Core ;; Copyright (C) 2010 Johan Tibell ;; Author: Johan Tibell ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; Purpose: ;; ;; To make it easier to read GHC Core output by providing highlighting ;; and removal of commonly ignored annotations. ;;; Code: (require 'haskell-mode) (require 'haskell-font-lock) (defgroup ghc-core nil "Major mode for viewing pretty printed GHC Core output." :link '(custom-manual "(haskell-mode)") :group 'haskell :prefix "ghc-core-") (defcustom ghc-core-program "ghc" "Name of the GHC executable (excluding any arguments)." :type 'string :group 'ghc-core) (defcustom ghc-core-program-args '("-O2") "Additional options to be passed to GHC when generating core output. GHC (see variable `ghc-core-program') is invoked with the basic command line options \"-ddump-simpl -c \" followed by the additional options defined here. The following `-ddump-simpl` options might be of interest: - `-dsuppress-all' - `-dsuppress-uniques' - `-dsuppress-idinfo' - `-dsuppress-module-prefixes' - `-dsuppress-type-signatures' - `-dsuppress-type-applications' - `-dsuppress-coercions' See `M-x manual-entry RET ghc' for more details." :type '(repeat (string :tag "Argument")) :group 'ghc-core) (define-obsolete-variable-alias 'ghc-core-create-options 'ghc-core-program-args "haskell-mode 13.7") (defun ghc-core-clean-region (start end) "Remove commonly ignored annotations and namespace prefixes in the region between START and END." (interactive "r") (save-restriction (narrow-to-region start end) (goto-char (point-min)) (while (search-forward-regexp "GHC\.[^\.]*\." nil t) (replace-match "" nil t)) (goto-char (point-min)) (while (flush-lines "^ *GblId *$" nil)) (goto-char (point-min)) (while (flush-lines "^ *LclId *$" nil)) (goto-char (point-min)) (while (flush-lines (concat "^ *\\[\\(?:Arity [0-9]+\\|NoCafRefs\\|" "Str: DmdType\\|Worker \\)" "\\([^]]*\\n?\\).*\\] *$") nil)) (goto-char (point-min)) (while (search-forward "Main." nil t) (replace-match "" nil t)))) (defun ghc-core-clean-buffer () "Remove commonly ignored annotations and namespace prefixes in the current buffer." (interactive) (ghc-core-clean-region (point-min) (point-max))) ;;;###autoload (defun ghc-core-create-core () "Compile and load the current buffer as tidy core." (interactive) (save-buffer) (let* ((core-buffer (generate-new-buffer "ghc-core")) (neh (lambda () (kill-buffer core-buffer)))) (add-hook 'next-error-hook neh) (apply #'call-process ghc-core-program nil core-buffer nil "-ddump-simpl" "-c" (buffer-file-name) ghc-core-program-args) (display-buffer core-buffer) (with-current-buffer core-buffer (ghc-core-mode)) (remove-hook 'next-error-hook neh))) ;;;###autoload (add-to-list 'auto-mode-alist '("\\.hcr\\'" . ghc-core-mode)) ;;;###autoload (add-to-list 'auto-mode-alist '("\\.dump-simpl\\'" . ghc-core-mode)) ;;;###autoload (define-derived-mode ghc-core-mode haskell-mode "GHC-Core" "Major mode for GHC Core files.") (provide 'ghc-core) ;;; ghc-core.el ends here haskell-mode-13.14.2/ghci-script-mode.el000066400000000000000000000054071253441665600177310ustar00rootroot00000000000000;;; ghci-script-mode.el --- GHCi scripts major mode ;; Copyright (c) 2014 Chris Done. All rights reserved. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: (require 'haskell) (defvar ghci-script-mode-keywords ;; The comment syntax can't be described simply in syntax-table. ;; We could use font-lock-syntactic-keywords, but is it worth it? '(("^[ \t]*--.*" . font-lock-comment-face) ("^ *\\([^ \t:]+\\):" (1 font-lock-keyword-face)) ("^:[a-z{]+ *\\+" . font-lock-keyword-face) ("^:[a-z{]+ " . font-lock-keyword-face))) ;;;###autoload (define-derived-mode ghci-script-mode text-mode "GHCi-Script" "Major mode for working with .ghci files." (set (make-local-variable 'adaptive-fill-mode) nil) (set (make-local-variable 'comment-start) "-- ") (set (make-local-variable 'comment-padding) 0) (set (make-local-variable 'comment-start-skip) "[-{]-[ \t]*") (set (make-local-variable 'comment-end) "") (set (make-local-variable 'comment-end-skip) "[ \t]*\\(-}\\|\\s>\\)") (set (make-local-variable 'indent-line-function) 'haskell-mode-suggest-indent-choice) (set (make-local-variable 'font-lock-defaults) '(ghci-script-mode-keywords t t nil nil)) (set (make-local-variable 'indent-tabs-mode) nil) (set (make-local-variable 'tab-width) 8) (when (boundp 'electric-indent-inhibit) (setq electric-indent-inhibit t)) (set (make-local-variable 'dabbrev-case-fold-search) nil) (set (make-local-variable 'dabbrev-case-distinction) nil) (set (make-local-variable 'dabbrev-case-replace) nil) (set (make-local-variable 'dabbrev-abbrev-char-regexp) "\\sw\\|[.]") (setq haskell-literate nil)) ;;;###autoload (add-to-list 'auto-mode-alist '("\\.ghci\\'" . ghci-script-mode)) (define-key ghci-script-mode-map (kbd "C-c C-l") 'ghci-script-mode-load) (defun ghci-script-mode-load () (interactive) "Load the current script file into the GHCi session." (let ((buffer (haskell-session-interactive-buffer (haskell-session))) (filename (buffer-file-name))) (save-buffer) (with-current-buffer buffer (set-marker haskell-interactive-mode-prompt-start (point-max)) (haskell-interactive-mode-run-expr (concat ":script " filename))))) (provide 'ghci-script-mode) haskell-mode-13.14.2/haskell-align-imports.el000066400000000000000000000205641253441665600210020ustar00rootroot00000000000000;;; haskell-align-imports.el --- Align the import lines in a Haskell file ;; Copyright (C) 2010 Chris Done ;; Author: Chris Done ;; This file is not part of GNU Emacs. ;; This program is free software: you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as ;; published by the Free Software Foundation, either version 3 of ;; the License, or (at your option) any later version. ;; This program is distributed in the hope that it will be ;; useful, but WITHOUT ANY WARRANTY; without even the implied ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. See the GNU General Public License for more details. ;; You should have received a copy of the GNU General Public ;; License along with this program. If not, see ;; . ;;; Commentary: ;; Consider the following imports list: ;; ;; import One ;; import Two as A ;; import qualified Three ;; import qualified Four as PRELUDE ;; import Five (A) ;; import Six (A,B) ;; import qualified Seven (A,B) ;; import "abc" Eight ;; import "abc" Nine as TWO ;; import qualified "abc" Ten ;; import qualified "defg" Eleven as PRELUDE ;; import "barmu" Twelve (A) ;; import "zotconpop" Thirteen (A,B) ;; import qualified "z" Fourteen (A,B) ;; import Fifteen hiding (A) ;; import Sixteen as TWO hiding (A) ;; import qualified Seventeen hiding (A) ;; import qualified Eighteen as PRELUDE hiding (A) ;; import "abc" Nineteen hiding (A) ;; import "abc" Twenty as TWO hiding (A) ;; ;; When haskell-align-imports is run within the same buffer, the ;; import list is transformed to: ;; ;; import "abc" Eight ;; import qualified Eighteen as PRELUDE hiding (A) ;; import qualified "defg" Eleven as PRELUDE ;; import Fifteen hiding (A) ;; import Five (A) ;; import qualified Four as PRELUDE ;; import qualified "z" Fourteen (A,B) ;; import "abc" Nine as TWO ;; import "abc" Nineteen hiding (A) ;; import One ;; import qualified Seven (A,B) ;; import qualified Seventeen hiding (A) ;; import Six (A,B) ;; import Sixteen as TWO hiding (A) ;; import qualified "abc" Ten ;; import "zotconpop" Thirteen (A,B) ;; import qualified Three ;; import "barmu" Twelve (A) ;; import "abc" Twenty as TWO hiding (A) ;; import Two as A ;; ;; If you want everything after module names to be padded out, too, ;; customize `haskell-align-imports-pad-after-name', and you'll get: ;; ;; import One ;; import Two as A ;; import qualified Three ;; import qualified Four as PRELUDE ;; import Five (A) ;; import Six (A,B) ;; import qualified Seven (A,B) ;; import "abc" Eight ;; import "abc" Nine as TWO ;; import qualified "abc" Ten ;; import qualified "defg" Eleven as PRELUDE ;; import "barmu" Twelve (A) ;; import "zotconpop" Thirteen (A,B) ;; import qualified "z" Fourteen (A,B) ;; import Fifteen hiding (A) ;; import Sixteen as TWO hiding (A) ;; import qualified Seventeen hiding (A) ;; import qualified Eighteen as PRELUDE hiding (A) ;; import "abc" Nineteen hiding (A) ;; import "abc" Twenty as TWO hiding (A) ;;; Code: (require 'cl-lib) (defvar haskell-align-imports-regexp (concat "^\\(import[ ]+\\)" "\\(qualified \\)?" "[ ]*\\(\"[^\"]*\" \\)?" "[ ]*\\([A-Za-z0-9_.']+\\)" "[ ]*\\([ ]*as [A-Z][^ ]*\\)?" "[ ]*\\((.*)\\)?" "\\([ ]*hiding (.*)\\)?" "\\( -- .*\\)?[ ]*$") "Regex used for matching components of an import.") (defcustom haskell-align-imports-pad-after-name nil "Pad layout after the module name also." :type 'boolean :group 'haskell-interactive) ;;;###autoload (defun haskell-align-imports () "Align all the imports in the buffer." (interactive) (when (haskell-align-imports-line-match) (save-excursion (goto-char (point-min)) (let* ((imports (haskell-align-imports-collect)) (padding (haskell-align-imports-padding imports))) (mapc (lambda (x) (goto-char (cdr x)) (delete-region (point) (line-end-position)) (insert (haskell-align-imports-chomp (haskell-align-imports-fill padding (car x))))) imports)))) nil) (defun haskell-align-imports-line-match () "Try to match the current line as a regexp." (let ((line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) (if (string-match "^import " line) line nil))) (defun haskell-align-imports-collect () "Collect a list of mark / import statement pairs." (let ((imports '())) (while (not (or (equal (point) (point-max)) (haskell-align-imports-after-imports-p))) (let ((line (haskell-align-imports-line-match-it))) (when line (let ((match (haskell-align-imports-merge-parts (cl-loop for i from 1 to 8 collect (haskell-align-imports-chomp (match-string i line)))))) (setq imports (cons (cons match (line-beginning-position)) imports))))) (forward-line)) imports)) (defun haskell-align-imports-merge-parts (l) "Merge together parts of an import statement that shouldn't be separated." (let ((parts (apply #'vector l)) (join (lambda (ls) (cl-reduce (lambda (a b) (concat a (if (and (> (length a) 0) (> (length b) 0)) " " "") b)) ls)))) (if haskell-align-imports-pad-after-name (list (funcall join (list (aref parts 0) (aref parts 1) (aref parts 2))) (aref parts 3) (funcall join (list (aref parts 4) (aref parts 5) (aref parts 6))) (aref parts 7)) (list (funcall join (list (aref parts 0) (aref parts 1) (aref parts 2))) (funcall join (list (aref parts 3) (aref parts 4) (aref parts 5) (aref parts 6) (aref parts 7))))))) (defun haskell-align-imports-chomp (str) "Chomp leading and tailing whitespace from STR." (if str (replace-regexp-in-string "\\(^[[:space:]\n]*\\|[[:space:]\n]*$\\)" "" str) "")) (defun haskell-align-imports-padding (imports) "Find the padding for each part of the import statements." (if (null imports) imports (cl-reduce (lambda (a b) (cl-mapcar #'max a b)) (mapcar (lambda (x) (mapcar #'length (car x))) imports)))) (defun haskell-align-imports-fill (padding line) "Fill an import line using the padding worked out from all statements." (mapconcat #'identity (cl-mapcar (lambda (pad part) (if (> (length part) 0) (concat part (make-string (- pad (length part)) ? )) (make-string pad ? ))) padding line) " ")) (defun haskell-align-imports-line-match-it () "Try to match the current line as a regexp." (let ((line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) (if (string-match haskell-align-imports-regexp line) line nil))) (defun haskell-align-imports-after-imports-p () "Are we after the imports list?" (save-excursion (goto-char (line-beginning-position)) (not (not (search-forward-regexp "\\( = \\|\\\\| :: \\| ∷ \\)" (line-end-position) t 1))))) (provide 'haskell-align-imports) ;;; haskell-align-imports.el ends here haskell-mode-13.14.2/haskell-bot.el000066400000000000000000000131051253441665600167720ustar00rootroot00000000000000;;; haskell-bot.el --- A Lambdabot interaction mode ;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc. ;; Copyright (C) 2001 Chris Webb ;; Copyright (C) 1998, 1999 Guy Lapalme ;; Keywords: inferior mode, Bot interaction mode, Haskell ;;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; Purpose: ;; ;; To send a Haskell buffer to another buffer running a Bot ;; interpreter. ;; ;; This mode is derived from version 1.1 of Guy Lapalme's ;; haskell-hugs.el, which can be obtained from: ;; ;; http://www.iro.umontreal.ca/~lapalme/Hugs-interaction.html ;; ;; This in turn was adapted from Chris Van Humbeeck's hugs-mode.el, ;; which can be obtained from: ;; ;; http://www-i2.informatik.rwth-aachen.de/Forschung/FP/Haskell/hugs-mode.el ;; ;; ;; Installation: ;; ;; To use with Moss and Thorn's haskell-mode.el ;; ;; http://www.haskell.org/haskell-mode ;; ;; add this to .emacs: ;; ;; (add-hook 'haskell-mode-hook 'haskell-bot-mode) ;; ;; ;; Customisation: ;; ;; The name of the Bot interpreter is in haskell-bot-program-name. ;; ;; Arguments can be sent to the Bot interpreter when it is started by ;; setting haskell-bot-program-args (empty by default) to a list of ;; string args to pass it. This value can be set interactively by ;; calling C-c C-s with an argument (i.e. C-u C-c C-s). ;; ;; `haskell-bot-hook' is invoked in the *bot* buffer once Bot is ;; started. ;; ;; All functions/variables start with `turn-{on,off}-haskell-bot' or ;; `haskell-bot-'. ;;; Code: (require 'comint) (defgroup haskell-bot nil "Major mode for interacting with an inferior Bot session." :group 'haskell :prefix "haskell-bot-") (define-derived-mode haskell-bot-mode comint-mode "Lambdabot") ;; Bot interface: (require 'comint) (require 'shell) (defvar haskell-bot-process nil "The active Bot subprocess corresponding to current buffer.") (defvar haskell-bot-process-buffer nil "*Buffer used for communication with Bot subprocess for current buffer.") (defcustom haskell-bot-program-name "lambdabot" "*The name of the Bot interpreter program." :type 'string :group 'haskell-bot) (defcustom haskell-bot-program-args nil "*A list of string args to pass when starting the Bot interpreter." :type '(repeat string) :group 'haskell-bot) (defvar haskell-bot-load-end nil "Position of the end of the last load command.") (defvar haskell-bot-error-pos nil "Position of the end of the last load command.") (defvar haskell-bot-send-end nil "Position of the end of the last send command.") (defvar haskell-bot-comint-prompt-regexp "^lambdabot> " "A regexp that matches the Bot prompt.") (defun haskell-bot-start-process (arg) "Start a Bot process and invoke `haskell-bot-hook' if not nil. Prompt for a list of args if called with an argument." (interactive "P") (if arg ;; XXX [CDW] Fix to use more natural 'string' version of the ;; XXX arguments rather than a sexp. (setq haskell-bot-program-args (read-minibuffer (format "List of args for %s:" haskell-bot-program-name) (prin1-to-string haskell-bot-program-args)))) ;; Start the Bot process in a new comint buffer. (message "Starting Lambdabot process `%s'." haskell-bot-program-name) (setq haskell-bot-process-buffer (apply 'make-comint "lambdabot" haskell-bot-program-name nil haskell-bot-program-args)) (setq haskell-bot-process (get-buffer-process haskell-bot-process-buffer)) ;; Select Bot buffer temporarily. (set-buffer haskell-bot-process-buffer) (haskell-bot-mode) (setq comint-prompt-regexp haskell-bot-comint-prompt-regexp) ;; History syntax of comint conflicts with Haskell, e.g. !!, so better ;; turn it off. (setq comint-input-autoexpand nil) (setq comint-process-echoes nil) (run-hooks 'haskell-bot-hook) ;; Clear message area. (message "")) (defun haskell-bot-wait-for-output () "Wait until output arrives and go to the last input." (while (progn (goto-char comint-last-input-end) (not (re-search-forward comint-prompt-regexp nil t))) (accept-process-output haskell-bot-process))) (defun haskell-bot-send (&rest string) "Send `haskell-bot-process' the arguments (one or more strings). A newline is sent after the strings and they are inserted into the current buffer after the last output." (haskell-bot-wait-for-output) ; wait for prompt (goto-char (point-max)) ; position for this input (apply 'insert string) (comint-send-input) (setq haskell-bot-send-end (marker-position comint-last-input-end))) (defun haskell-bot-show-bot-buffer () "Go to the *bot* buffer." (interactive) (if (or (not haskell-bot-process-buffer) (not (buffer-live-p haskell-bot-process-buffer))) (haskell-bot-start-process nil)) (pop-to-buffer haskell-bot-process-buffer)) (provide 'haskell-bot) ;;; haskell-bot.el ends here haskell-mode-13.14.2/haskell-cabal.el000066400000000000000000001057211253441665600172560ustar00rootroot00000000000000;;; haskell-cabal.el --- Support for Cabal packages ;; Copyright (C) 2007, 2008 Stefan Monnier ;; Author: Stefan Monnier ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; Todo: ;; - distinguish continued lines from indented lines. ;; - indent-line-function. ;; - outline-minor-mode. ;;; Code: ;; (defun haskell-cabal-extract-fields-from-doc () ;; (require 'xml) ;; (with-no-warnings (require 'cl)) ;; (let ((section (completing-read ;; "Section: " ;; '("general-fields" "library" "executable" "buildinfo")))) ;; (goto-char (point-min)) ;; (search-forward (concat ""))) ;; (let* ((xml (xml-parse-region ;; (progn (search-forward "") (match-beginning 0)) ;; (progn (search-forward "") (point)))) ;; (varlist (remove-if-not 'consp (cddar xml))) ;; (syms (mapcar (lambda (entry) (caddr (assq 'literal (assq 'term entry)))) ;; varlist)) ;; (fields (mapcar (lambda (sym) (substring-no-properties sym 0 -1)) syms))) ;; fields)) (require 'cl-lib) (require 'haskell-utils) (defconst haskell-cabal-general-fields ;; Extracted with (haskell-cabal-extract-fields-from-doc "general-fields") '("name" "version" "cabal-version" "license" "license-file" "copyright" "author" "maintainer" "stability" "homepage" "package-url" "synopsis" "description" "category" "tested-with" "build-depends" "data-files" "extra-source-files" "extra-tmp-files")) (defconst haskell-cabal-library-fields ;; Extracted with (haskell-cabal-extract-fields-from-doc "library") '("exposed-modules")) (defconst haskell-cabal-executable-fields ;; Extracted with (haskell-cabal-extract-fields-from-doc "executable") '("executable" "main-is")) (defconst haskell-cabal-buildinfo-fields ;; Extracted with (haskell-cabal-extract-fields-from-doc "buildinfo") '("buildable" "other-modules" "hs-source-dirs" "extensions" "ghc-options" "ghc-prof-options" "hugs-options" "nhc-options" "includes" "install-includes" "include-dirs" "c-sources" "extra-libraries" "extra-lib-dirs" "cc-options" "ld-options" "frameworks")) (defvar haskell-cabal-mode-syntax-table (let ((st (make-syntax-table))) ;; The comment syntax can't be described simply in syntax-table. ;; We could use font-lock-syntactic-keywords, but is it worth it? ;; (modify-syntax-entry ?- ". 12" st) (modify-syntax-entry ?\n ">" st) (modify-syntax-entry ?. "w" st) (modify-syntax-entry ?- "w" st) st)) (defvar haskell-cabal-font-lock-keywords ;; The comment syntax can't be described simply in syntax-table. ;; We could use font-lock-syntactic-keywords, but is it worth it? '(("^[ \t]*--.*" . font-lock-comment-face) ("^ *\\([^ \t:]+\\):" (1 font-lock-keyword-face)) ("^\\(Library\\)[ \t]*\\({\\|$\\)" (1 font-lock-keyword-face)) ("^\\(Executable\\|Test-Suite\\|Benchmark\\)[ \t]+\\([^\n \t]*\\)" (1 font-lock-keyword-face) (2 font-lock-function-name-face)) ("^\\(Flag\\)[ \t]+\\([^\n \t]*\\)" (1 font-lock-keyword-face) (2 font-lock-constant-face)) ("^\\(Source-Repository\\)[ \t]+\\(head\\|this\\)" (1 font-lock-keyword-face) (2 font-lock-constant-face)) ("^ *\\(if\\)[ \t]+.*\\({\\|$\\)" (1 font-lock-keyword-face)) ("^ *\\(}[ \t]*\\)?\\(else\\)[ \t]*\\({\\|$\\)" (2 font-lock-keyword-face)))) (defvar haskell-cabal-buffers nil "List of Cabal buffers.") (defun haskell-cabal-buffers-clean (&optional buffer) (let ((bufs ())) (dolist (buf haskell-cabal-buffers) (if (and (buffer-live-p buf) (not (eq buf buffer)) (with-current-buffer buf (derived-mode-p 'haskell-cabal-mode))) (push buf bufs))) (setq haskell-cabal-buffers bufs))) (defun haskell-cabal-unregister-buffer () (haskell-cabal-buffers-clean (current-buffer))) ;;;###autoload (add-to-list 'auto-mode-alist '("\\.cabal\\'" . haskell-cabal-mode)) (defvar haskell-cabal-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-s") 'haskell-cabal-subsection-arrange-lines) (define-key map (kbd "C-M-n") 'haskell-cabal-next-section) (define-key map (kbd "C-M-p") 'haskell-cabal-previous-section) (define-key map (kbd "M-n") 'haskell-cabal-next-subsection) (define-key map (kbd "M-p") 'haskell-cabal-previous-subsection) (define-key map (kbd "C-") 'haskell-cabal-next-subsection) (define-key map (kbd "C-") 'haskell-cabal-previous-subsection) (define-key map (kbd "C-c C-f") 'haskell-cabal-find-or-create-source-file) (define-key map (kbd "M-g l") 'haskell-cabal-goto-library-section) (define-key map (kbd "M-g e") 'haskell-cabal-goto-executable-section) (define-key map (kbd "M-g b") 'haskell-cabal-goto-benchmark-section) (define-key map (kbd "M-g t") 'haskell-cabal-goto-test-suite-section) map)) ;;;###autoload (define-derived-mode haskell-cabal-mode fundamental-mode "Haskell-Cabal" "Major mode for Cabal package description files." (set (make-local-variable 'font-lock-defaults) '(haskell-cabal-font-lock-keywords t t nil nil)) (add-to-list 'haskell-cabal-buffers (current-buffer)) (add-hook 'change-major-mode-hook 'haskell-cabal-unregister-buffer nil 'local) (add-hook 'kill-buffer-hook 'haskell-cabal-unregister-buffer nil 'local) (set (make-local-variable 'comment-start) "-- ") (set (make-local-variable 'comment-start-skip) "\\(^[ \t]*\\)--[ \t]*") (set (make-local-variable 'comment-end) "") (set (make-local-variable 'comment-end-skip) "[ \t]*\\(\\s>\\|\n\\)") (set (make-local-variable 'indent-line-function) 'haskell-cabal-indent-line) (setq indent-tabs-mode nil) ) (defun haskell-cabal-get-setting (name) (save-excursion (let ((case-fold-search t)) (goto-char (point-min)) (when (re-search-forward (concat "^[ \t]*" (regexp-quote name) ":[ \t]*\\(.*\\(\n[ \t]+[ \t\n].*\\)*\\)") nil t) (let ((val (match-string 1)) (start 1)) (when (match-end 2) ;Multiple lines. ;; The documentation is not very precise about what to do about ;; the \n and the indentation: are they part of the value or ;; the encoding? I take the point of view that \n is part of ;; the value (so that values can span multiple lines as well), ;; and that only the first char in the indentation is part of ;; the encoding, the rest is part of the value (otherwise, lines ;; in the value cannot start with spaces or tabs). (while (string-match "^[ \t]\\(?:\\.$\\)?" val start) (setq start (1+ (match-beginning 0))) (setq val (replace-match "" t t val)))) val))))) ;;;###autoload (defun haskell-cabal-guess-setting (name) "Guess the specified setting of this project. If there is no valid .cabal file to get the setting from (or there is no corresponding setting with that name in the .cabal file), then this function returns nil." (interactive) (when (and name buffer-file-name) (let ((cabal-file (haskell-cabal-find-file))) (when (and cabal-file (file-readable-p cabal-file)) (with-temp-buffer (insert-file-contents cabal-file) (haskell-cabal-get-setting name)))))) ;;;###autoload (defun haskell-cabal-get-dir () "Get the Cabal dir for a new project. Various ways of figuring this out, and indeed just prompting the user. Do them all." (let* ((file (haskell-cabal-find-file)) (dir (when file (file-name-directory file)))) (haskell-utils-read-directory-name (format "Cabal dir%s: " (if file (format " (guessed from %s)" (file-relative-name file)) "")) dir))) (defun haskell-cabal-compute-checksum (dir) "Compute MD5 checksum of package description file in DIR. Return nil if no Cabal description file could be located via `haskell-cabal-find-pkg-desc'." (let ((cabal-file (haskell-cabal-find-pkg-desc dir))) (when cabal-file (with-temp-buffer (insert-file-contents cabal-file) (md5 (buffer-string)))))) (defun haskell-cabal-find-file (&optional dir) "Search for package description file upwards starting from DIR. If DIR is nil, `default-directory' is used as starting point for directory traversal. Upward traversal is aborted if file owner changes. Uses`haskell-cabal-find-pkg-desc' internally." (let ((use-dir (or dir default-directory))) (while (and use-dir (not (file-directory-p use-dir))) (setq use-dir (file-name-directory (directory-file-name use-dir)))) (when use-dir (catch 'found (let ((user (nth 2 (file-attributes use-dir))) ;; Abbreviate, so as to stop when we cross ~/. (root (abbreviate-file-name use-dir))) ;; traverse current dir up to root as long as file owner doesn't change (while (and root (equal user (nth 2 (file-attributes root)))) (let ((cabal-file (haskell-cabal-find-pkg-desc root))) (when cabal-file (throw 'found cabal-file))) (let ((proot (file-name-directory (directory-file-name root)))) (if (equal proot root) ;; fix-point reached? (throw 'found nil) (setq root proot)))) nil))))) (defun haskell-cabal-find-pkg-desc (dir &optional allow-multiple) "Find a package description file in the directory DIR. Returns nil if none or multiple \".cabal\" files were found. If ALLOW-MULTIPLE is non nil, in case of multiple \".cabal\" files, a list is returned instead of failing with a nil result." ;; This is basically a port of Cabal's ;; Distribution.Simple.Utils.findPackageDesc function ;; http://hackage.haskell.org/packages/archive/Cabal/1.16.0.3/doc/html/Distribution-Simple-Utils.html ;; but without the exception throwing. (let* ((cabal-files (cl-remove-if 'file-directory-p (cl-remove-if-not 'file-exists-p (directory-files dir t ".\\.cabal\\'"))))) (cond ((= (length cabal-files) 1) (car cabal-files)) ;; exactly one candidate found (allow-multiple cabal-files) ;; pass-thru multiple candidates (t nil)))) (defun haskell-cabal-find-dir (&optional dir) "Like `haskell-cabal-find-file' but returns directory instead. See `haskell-cabal-find-file' for meaning of DIR argument." (let ((cabal-file (haskell-cabal-find-file dir))) (when cabal-file (file-name-directory cabal-file)))) ;;;###autoload (defun haskell-cabal-visit-file (other-window) "Locate and visit package description file for file visited by current buffer. This uses `haskell-cabal-find-file' to locate the closest \".cabal\" file and open it. This command assumes a common Cabal project structure where the \".cabal\" file is in the top-folder of the project, and all files related to the project are in or below the top-folder. If called with non-nil prefix argument OTHER-WINDOW use `find-file-other-window'." (interactive "P") ;; Note: We aren't allowed to rely on haskell-session here (which, ;; in pathological cases, can have a different .cabal file ;; associated with the current buffer) (if buffer-file-name (let ((cabal-file (haskell-cabal-find-file (file-name-directory buffer-file-name)))) (if cabal-file (if other-window (find-file-other-window cabal-file) (find-file cabal-file)) (error "Could not locate \".cabal\" file for %S" buffer-file-name))) (error "Cannot locate \".cabal\" file for buffers not visiting any file"))) (defvar haskell-cabal-commands '("install" "update" "list" "info" "upgrade" "fetch" "unpack" "check" "sdist" "upload" "report" "init" "configure" "build" "copy" "haddock" "clean" "hscolour" "register" "test" "help" "run")) (defgroup haskell-cabal nil "Haskell cabal files" :group 'haskell ) (defcustom haskell-cabal-list-comma-position 'before "Where to put the comma in lists" :safe t :group 'haskell-cabal :type '(choice (const before) (const after))) (defconst haskell-cabal-section-header-regexp "^[[:alnum:]]" ) (defconst haskell-cabal-subsection-header-regexp "^[ \t]*[[:alnum:]]\\w*:") (defconst haskell-cabal-comment-regexp "^[ \t]*--") (defconst haskell-cabal-empty-regexp "^[ \t]*$") (defconst haskell-cabal-conditional-regexp "^[ \t]*\\(\\if\\|else\\|}\\)") (defun haskell-cabal-classify-line () "Classify the current line into 'section-header 'subsection-header 'section-data 'comment and 'empty '" (save-excursion (beginning-of-line) (cond ((looking-at haskell-cabal-subsection-header-regexp ) 'subsection-header) ((looking-at haskell-cabal-section-header-regexp) 'section-header) ((looking-at haskell-cabal-comment-regexp) 'comment) ((looking-at haskell-cabal-empty-regexp ) 'empty) ((looking-at haskell-cabal-conditional-regexp ) 'conditional) (t 'section-data)))) (defun haskell-cabal-header-p () "Is the current line a section or subsection header?" (cl-case (haskell-cabal-classify-line) ((section-header subsection-header) t))) (defun haskell-cabal-section-header-p () "Is the current line a section or subsection header?" (cl-case (haskell-cabal-classify-line) ((section-header) t))) (defun haskell-cabal-section-beginning () "Find the beginning of the current section" (save-excursion (while (not (or (bobp) (haskell-cabal-section-header-p))) (forward-line -1)) (point))) (defun haskell-cabal-beginning-of-section () "go to the beginning of the section" (interactive) (goto-char (haskell-cabal-section-beginning)) ) (defun haskell-cabal-section-end () "Find the end of the current section" (interactive) (save-excursion (if (re-search-forward "\n\\([ \t]*\n\\)*[[:alnum:]]" nil t) (match-beginning 0) (point-max)))) (defun haskell-cabal-end-of-section () "go to the end of the section" (interactive) (goto-char (haskell-cabal-section-end))) (defun haskell-cabal-next-section () "Go to the next extion" (interactive) (when (haskell-cabal-section-header-p) (forward-line)) (while (not (or (eobp) (haskell-cabal-section-header-p))) (forward-line))) (defun haskell-cabal-previous-section () "Go to the next extion" (interactive) (when (haskell-cabal-section-header-p) (forward-line -1)) (while (not (or (bobp) (haskell-cabal-section-header-p))) (forward-line -1))) (defun haskell-cabal-subsection-end () "find the end of the current subsection" (save-excursion (haskell-cabal-beginning-of-subsection) (forward-line) (while (and (not (eobp)) (member (haskell-cabal-classify-line) '(empty section-data))) (forward-line)) (unless (eobp) (forward-line -1)) (while (and (equal (haskell-cabal-classify-line) 'empty) (not (bobp))) (forward-line -1)) (end-of-line) (point))) (defun haskell-cabal-end-of-subsection () "go to the end of the current subsection" (interactive) (goto-char (haskell-cabal-subsection-end))) (defun haskell-cabal-section () "Get the name and data of the associated section" (save-excursion (haskell-cabal-beginning-of-section) (when (and (haskell-cabal-section-header-p) (looking-at "^\\(\\w+\\)[ \t]*\\(.*\\)$")) (list :name (match-string-no-properties 1) :value (match-string-no-properties 2) :beginning (match-beginning 0) :end (haskell-cabal-section-end))))) (defun haskell-cabal-subsection () "Get the name and bounds of of the current subsection" (save-excursion (haskell-cabal-beginning-of-subsection) (when (looking-at "\\([ \t]*\\(\\w*\\):\\)[ \t]*") (list :name (match-string-no-properties 2) :beginning (match-end 0) :end (save-match-data (haskell-cabal-subsection-end)) :data-start-column (save-excursion (goto-char (match-end 0)) (current-column) ))))) (defun haskell-cabal-section-name (section) (plist-get section :name)) (defun haskell-cabal-section-value (section) (plist-get section :value)) (defun haskell-cabal-section-start (section) (plist-get section :beginning)) (defun haskell-cabal-section-data-start-column (section) (plist-get section :data-start-column)) (defmacro haskell-cabal-with-subsection (subsection replace &rest funs) "Copy subsection data into a temporary buffer, save indentation and execute FORMS If REPLACE is non-nil the subsection data is replaced with the resultung buffer-content" (let ((section (make-symbol "section")) (beg (make-symbol "beg")) (end (make-symbol "end")) (start-col (make-symbol "start-col")) (section-data (make-symbol "section-data"))) `(let* ((,section ,subsection) (,beg (plist-get ,section :beginning)) (,end (plist-get ,section :end)) (,start-col (plist-get ,section :data-start-column)) (,section-data (buffer-substring ,beg ,end)) (section-name (plist-get ,section :name ))) (save-excursion (prog1 (with-temp-buffer (setq indent-tabs-mode nil) (indent-to ,start-col) (insert ,section-data) (goto-char (point-min)) (prog1 (progn (haskell-cabal-save-indentation ,@funs)) (goto-char (point-min)) (when (looking-at (format "[ ]\\{0,%d\\}" (1+ ,start-col))) (replace-match "")) (setq ,section-data (buffer-substring (point-min) (point-max))))) ,@(when replace `((delete-region ,beg ,end) (goto-char ,beg) (insert ,section-data)))))))) (defmacro haskell-cabal-each-line (&rest fun) "Execute FOMRS on each line" `(save-excursion (while (< (point) (point-max)) ,@fun (forward-line)))) (defun haskell-cabal-chomp-line () "Remove leading and trailing whitespaces from current line" (beginning-of-line) (when (looking-at "^[ \t]*\\([^ \t]\\|\\(?:[^ \t].*[^ \t]\\)\\)[ \t]*$") (replace-match (match-string 1) nil t) t)) (defun haskell-cabal-min-indentation (&optional beg end) "Compute largest common whitespace prefix of each line in between BEG and END" (save-excursion (goto-char (or beg (point-min))) (let ((min-indent nil)) (while (< (point) (or end (point-max))) (let ((indent (current-indentation))) (if (and (not (haskell-cabal-ignore-line-p)) (or (not min-indent) (< indent min-indent))) (setq min-indent indent))) (forward-line)) min-indent))) (defun haskell-cabal-ignore-line-p () "Does line only contain whitespaces and comments?" (save-excursion (beginning-of-line) (looking-at "^[ \t]*\\(?:--.*\\)?$"))) (defun haskell-cabal-kill-indentation () "Remove longest common whitespace prefix from each line" (goto-char (point-min)) (let ((indent (haskell-cabal-min-indentation))) (haskell-cabal-each-line (unless (haskell-cabal-ignore-line-p) (delete-char indent)) ) indent)) (defun haskell-cabal-add-indentation (indent) (goto-char (point-min)) (haskell-cabal-each-line (unless (haskell-cabal-ignore-line-p) (indent-to indent)))) (defmacro haskell-cabal-save-indentation (&rest funs) "Strip indentation from each line, execute FORMS and reinstate indentation so that the indentation of the FIRST LINE matches" (let ((old-l1-indent (make-symbol "new-l1-indent")) (new-l1-indent (make-symbol "old-l1-indent")) (res nil)) `(let ( (,old-l1-indent (save-excursion (goto-char (point-min)) (current-indentation)))) (unwind-protect (progn (haskell-cabal-kill-indentation) ,@funs) (progn (goto-char (point-min)) (let ((,new-l1-indent (current-indentation))) (haskell-cabal-add-indentation (- ,old-l1-indent ,new-l1-indent)))))))) (defun haskell-cabal-strip-list () "strip commas from comma-seperated list" (goto-char (point-min)) ;; split list items on single line (while (re-search-forward "\\([^ \t,\n]\\)[ \t]*,[ \t]*\\([^ \t,\n]\\)" nil t) (replace-match "\\1\n\\2" nil nil)) (goto-char (point-min)) (while (re-search-forward "^\\([ \t]*\\),\\([ \t]*\\)" nil t) (replace-match "" nil nil)) (goto-char (point-min)) (while (re-search-forward ",[ \t]*$" nil t) (replace-match "" nil nil)) (goto-char (point-min)) (haskell-cabal-each-line (haskell-cabal-chomp-line))) (defun haskell-cabal-listify () "Add commas so that buffer contains a comma-seperated list" (cl-case haskell-cabal-list-comma-position ('before (goto-char (point-min)) (while (haskell-cabal-ignore-line-p) (forward-line)) (indent-to 2) (forward-line) (haskell-cabal-each-line (unless (haskell-cabal-ignore-line-p) (insert ", ")))) ('after (goto-char (point-max)) (while (not (bobp)) (unless (haskell-cabal-ignore-line-p) (forward-line -1) (end-of-line) (insert ",") (beginning-of-line)))))) (defmacro haskell-cabal-with-cs-list (&rest funs) "format buffer so that each line contains a list element " `(progn (save-excursion (haskell-cabal-strip-list)) (unwind-protect (progn ,@funs) (haskell-cabal-listify)))) (defun haskell-cabal-sort-lines-key-fun () (when (looking-at "[ \t]*--[ \t,]*") (goto-char (match-end 0))) nil) (defmacro haskell-cabal-save-position (&rest forms) "Save position as mark, execute FORMs and go back to mark" `(prog2 (haskell-cabal-mark) (progn ,@forms) (haskell-cabal-goto-mark) (haskell-cabal-remove-mark))) (defun haskell-cabal-subsection-arrange-lines () "Sort lines of current subsection" (interactive) (haskell-cabal-save-position (haskell-cabal-with-subsection (haskell-cabal-subsection) t (haskell-cabal-with-cs-list (sort-subr nil 'forward-line 'end-of-line 'haskell-cabal-sort-lines-key-fun) )))) (defun haskell-cabal-subsection-beginning () "find the beginning of the current subsection" (save-excursion (while (and (not (bobp)) (not (haskell-cabal-header-p))) (forward-line -1)) (back-to-indentation) (point))) (defun haskell-cabal-beginning-of-subsection () "go to the beginniing of the current subsection" (interactive) (goto-char (haskell-cabal-subsection-beginning))) (defun haskell-cabal-next-subsection () "go to the next subsection" (interactive) (if (haskell-cabal-header-p) (forward-line)) (while (and (not (eobp)) (not (haskell-cabal-header-p))) (forward-line)) (haskell-cabal-forward-to-line-entry)) (defun haskell-cabal-previous-subsection () "go to the next subsection" (interactive) (if (haskell-cabal-header-p) (forward-line -1)) (while (and (not (bobp)) (not (haskell-cabal-header-p))) (forward-line -1)) (haskell-cabal-forward-to-line-entry) ) (defun haskell-cabal-find-subsection-by (section pred) "Find sunsection with name NAME" (save-excursion (when section (goto-char (haskell-cabal-section-start section))) (let* ((end (if section (haskell-cabal-section-end) (point-max))) (found nil)) (while (and (< (point) end) (not found)) (let ((subsection (haskell-cabal-subsection))) (when (and subsection (funcall pred subsection)) (setq found subsection))) (haskell-cabal-next-subsection)) found))) (defun haskell-cabal-find-subsection (section name) "Find sunsection with name NAME" (let ((downcase-name (downcase name))) (haskell-cabal-find-subsection-by section '(lambda (subsection) (string= (downcase (haskell-cabal-section-name subsection)) downcase-name))))) (defun haskell-cabal-goto-subsection (name) (let ((subsection (haskell-cabal-find-subsection (haskell-cabal-section) name))) (when subsection (goto-char (haskell-cabal-section-start subsection))))) (defun haskell-cabal-goto-exposed-modules () (interactive) (haskell-cabal-goto-subsection "exposed-modules")) (defun haskell-cabal-subsection-entry-list (section name) "Get the data of a subsection as a list" (let ((subsection (haskell-cabal-find-subsection section name))) (when subsection (haskell-cabal-with-subsection subsection nil (haskell-cabal-with-cs-list (delete-matching-lines (format "\\(?:%s\\)\\|\\(?:%s\\)" haskell-cabal-comment-regexp haskell-cabal-empty-regexp) (point-min) (point-max)) (split-string (buffer-substring-no-properties (point-min) (point-max)) "\n" t)))))) (defun haskell-cabal-remove-mark () (remove-list-of-text-properties (point-min) (point-max) '(haskell-cabal-marker))) (defun haskell-cabal-mark () "Mark the current position with the text property haskell-cabal-marker" (haskell-cabal-remove-mark) (put-text-property (line-beginning-position) (line-end-position) 'haskell-cabal-marker 'marked-line) (put-text-property (point) (1+ (point)) 'haskell-cabal-marker 'marked)) (defun haskell-cabal-goto-mark () "Go to marked line" (let ((marked-pos (text-property-any (point-min) (point-max) 'haskell-cabal-marker 'marked)) (marked-line (text-property-any (point-min) (point-max) 'haskell-cabal-marker 'marked-line) ) ) (cond (marked-pos (goto-char marked-pos)) (marked-line (goto-char marked-line))))) (defmacro haskell-cabal-with-subsection-line (replace &rest forms) "Mark line and " `(progn (haskell-cabal-mark) (unwind-protect (haskell-cabal-with-subsection (haskell-cabal-subsection) ,replace (haskell-cabal-goto-mark) ,@forms) (haskell-cabal-remove-mark)))) (defun haskell-cabal-get-line-content () (haskell-cabal-with-subsection-line nil (haskell-cabal-with-cs-list (haskell-cabal-goto-mark) (buffer-substring-no-properties (line-beginning-position) (line-end-position))))) (defun haskell-cabal-module-to-filename (module) (concat (replace-regexp-in-string "[.]" "/" module ) ".hs")) (defconst haskell-cabal-module-sections '("exposed-modules" "other-modules") "List of sections that contain module names" ) (defconst haskell-cabal-file-sections '("main-is" "c-sources" "data-files" "extra-source-files" "extra-doc-files" "extra-tmp-files" ) "List of subsections that contain filenames" ) (defconst haskell-cabal-source-bearing-sections '("library" "executable" "test-suite" "benchmark")) (defun haskell-cabal-source-section-p (section) (not (not (member (downcase (haskell-cabal-section-name section)) haskell-cabal-source-bearing-sections)))) (defun haskell-cabal-line-filename () "Expand filename in current line according to the subsection type Module names in exposed-modules and other-modules are expanded by replacing each dot (.) in the module name with a foward slash (/) and appending \".hs\" Example: Foo.Bar.Quux ==> Foo/Bar/Quux.hs Source names from main-is and c-sources sections are left untouched " (let ((entry (haskell-cabal-get-line-content)) (subsection (downcase (haskell-cabal-section-name (haskell-cabal-subsection))))) (cond ((member subsection haskell-cabal-module-sections) (haskell-cabal-module-to-filename entry)) ((member subsection haskell-cabal-file-sections) entry)))) (defun haskell-cabal-join-paths (&rest args) "Crude hack to replace f-join" (mapconcat 'identity args "/") ) (defun haskell-cabal-find-or-create-source-file () "Open the source file this line refers to" (interactive) (let* ((src-dirs (append (haskell-cabal-subsection-entry-list (haskell-cabal-section) "hs-source-dirs") '(""))) (base-dir (file-name-directory (buffer-file-name))) (filename (haskell-cabal-line-filename))) (when filename (let ((candidates (delq nil (mapcar (lambda (dir) (let ((file (haskell-cabal-join-paths base-dir dir filename))) (when (and (file-readable-p file) (not (file-directory-p file))) file))) src-dirs)))) (if (null candidates) (let* ((src-dir (haskell-cabal-join-paths base-dir (or (car src-dirs) ""))) (newfile (haskell-cabal-join-paths src-dir filename)) (subdir (file-name-directory newfile)) (do-create-p (y-or-n-p (format "Create file %s ?" newfile)))) (when do-create-p (find-file-other-window newfile ))) (find-file-other-window (car candidates))))))) (defun haskell-cabal-find-section-type (type &optional wrap) (save-excursion (haskell-cabal-next-section) (while (not (or (eobp) (string= (downcase type) (downcase (haskell-cabal-section-name (haskell-cabal-section)))))) (haskell-cabal-next-section)) (if (eobp) (if wrap (progn (goto-char (point-min)) (haskell-cabal-find-section-type type nil) ) nil) (point)))) (defun haskell-cabal-goto-section-type (type) (let ((section (haskell-cabal-find-section-type type t))) (if section (goto-char section) (message "No %s section found" type)))) (defun haskell-cabal-goto-library-section () (interactive) (haskell-cabal-goto-section-type "library")) (defun haskell-cabal-goto-test-suite-section () (interactive) (haskell-cabal-goto-section-type "test-suite")) (defun haskell-cabal-goto-executable-section () (interactive) (haskell-cabal-goto-section-type "executable")) (defun haskell-cabal-goto-benchmark-section () (interactive) (haskell-cabal-goto-section-type "benchmark")) (defun haskell-cabal-line-entry-column () "Column at which the line entry starts" (save-excursion (cl-case (haskell-cabal-classify-line) (section-data (beginning-of-line) (when (looking-at "[ ]*\\(?:,[ ]*\\)?") (goto-char (match-end 0)) (current-column))) (subsection-header (haskell-cabal-section-data-start-column (haskell-cabal-subsection)))))) (defun haskell-cabal-forward-to-line-entry () "go forward to the beginning of the line entry (but never move backwards)" (let ((col (haskell-cabal-line-entry-column))) (when (and col (< (current-column) col)) (beginning-of-line) (forward-char col)))) (defun haskell-cabal-indent-line () "Indent current line according to subsection" (interactive) (cl-case (haskell-cabal-classify-line) (section-data (save-excursion (let ((indent (haskell-cabal-section-data-start-column (haskell-cabal-subsection)))) (indent-line-to indent) (beginning-of-line) (when (looking-at "[ ]*\\([ ]\\{2\\},[ ]*\\)") (replace-match ", " t t nil 1))))) (empty (indent-relative))) (haskell-cabal-forward-to-line-entry)) (defun haskell-cabal-map-sections (fun) "Execute fun over each section, collecting the result" (save-excursion (goto-char (point-min)) (let ((results nil)) (while (not (eobp)) (let* ((section (haskell-cabal-section)) (result (and section (funcall fun (haskell-cabal-section))))) (when section (setq results (cons result results)))) (haskell-cabal-next-section)) (nreverse results)))) (defun haskell-cabal-section-add-build-dependency (dependency &optional sort sec) "Add a build dependency to the build-depends section" (let* ((section (or sec (haskell-cabal-section))) (subsection (and section (haskell-cabal-find-subsection section "build-depends")))) (when subsection (haskell-cabal-with-subsection subsection t (haskell-cabal-with-cs-list (insert dependency) (insert "\n") (when sort (goto-char (point-min)) (sort-subr nil 'forward-line 'end-of-line 'haskell-cabal-sort-lines-key-fun))))))) (defun haskell-cabal-add-build-dependency (dependency &optional sort silent) "Add a build dependencies to sections" (haskell-cabal-map-sections (lambda (section) (when (haskell-cabal-source-section-p section) (when (or silent (y-or-n-p (format "Add dependency %s to %s section %s?" dependency (haskell-cabal-section-name section) (haskell-cabal-section-value section)))) (haskell-cabal-section-add-build-dependency dependency sort section) nil))))) (defun haskell-cabal-add-dependency (package &optional version no-prompt sort silent) "Add PACKAGE (and optionally suffix -VERSION) to the cabal file. Prompts the user before doing so. If VERSION is non-nil it will be appended as a minimum version. If NO-PROMPT is nil the minimum-version is read from the minibuffer When SORT is non-nil the package entries are sorted afterwards If SILENT ist nil the user is prompted for each source-section " (interactive (list (read-from-minibuffer "Package entry: ") nil t t nil)) (save-window-excursion (find-file-other-window (haskell-cabal-find-file)) (let ((entry (if no-prompt package (read-from-minibuffer "Package entry: " (concat package (if version (concat " >= " version) "")))))) (haskell-cabal-add-build-dependency entry sort silent) (when (or silent (y-or-n-p "Save cabal file?")) (save-buffer))))) (provide 'haskell-cabal) ;;; haskell-cabal.el ends here haskell-mode-13.14.2/haskell-checkers.el000066400000000000000000000146341253441665600200050ustar00rootroot00000000000000;;; haskell-checkers.el --- Emacs interface to haskell lint and style checkers ;; Copyright (C) 2009-2011 Alex Ott, Liam O'Reilly ;; ;; Author: Alex Ott , Liam O'Reilly ;; Keywords: haskell, lint, hlint, style scanner ;; Requirements: hlint, scan, haskell ;; This file is not part of GNU Emacs. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 2 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;;; Code: (require 'compile) (defgroup haskell-checkers nil "Run HLint as inferior of Emacs, parse error messages." :group 'haskell) ;;;###autoload (defcustom haskell-lint-command "hlint" "The default lint command for \\[hlint]." :type 'string :group 'haskell-checkers) (defcustom haskell-scan-command "scan" "The default scan command for \\[haskell-scan]." :type 'string :group 'haskell-checkers) (defcustom haskell-scan-options "" "The default options for \\[haskell-scan]." :type 'string :group 'haskell-checkers) (defcustom haskell-lint-options "" "The default options for \\[hlint]." :type 'string :group 'haskell-checkers) (defcustom haskell-checkers-save-files t "Save modified files when run checker or not (ask user)" :type 'boolean :group 'haskell-checkers) (defcustom haskell-checkers-replace-with-suggestions nil "Replace user's code with suggested replacements (hlint only)" :type 'boolean :group 'haskell-checkers) (defcustom haskell-checkers-replace-without-ask nil "Replace user's code with suggested replacements automatically (hlint only)" :type 'boolean :group 'haskell-checkers) ;; regex for replace HLint's suggestions ;; ;; ^\(.*?\):\([0-9]+\):\([0-9]+\): .* ;; Found: ;; \s +\(.*\) ;; Why not: ;; \s +\(.*\) (defvar haskell-lint-regex "^\\(.*?\\):\\([0-9]+\\):\\([0-9]+\\): .*[\n\C-m]Found:[\n\C-m]\\s +\\(.*\\)[\n\C-m]Why not:[\n\C-m]\\s +\\(.*\\)[\n\C-m]" "Regex for HLint messages") (defun haskell-checkers-make-short-string (str maxlen) (if (< (length str) maxlen) str (concat (substring str 0 (- maxlen 3)) "..."))) ;; TODO: check, is it possible to adopt it for haskell-scan? (defun haskell-lint-replace-suggestions () "Perform actual replacement of HLint's suggestions" (goto-char (point-min)) (while (re-search-forward haskell-lint-regex nil t) (let* ((fname (match-string 1)) (fline (string-to-number (match-string 2))) (old-code (match-string 4)) (new-code (match-string 5)) (msg (concat "Replace '" (haskell-checkers-make-short-string old-code 30) "' with '" (haskell-checkers-make-short-string new-code 30) "'")) (bline 0) (eline 0) (spos 0) (new-old-code "")) (save-excursion (switch-to-buffer (get-file-buffer fname)) (goto-char (point-min)) (forward-line (1- fline)) (beginning-of-line) (setq bline (point)) (when (or haskell-checkers-replace-without-ask (yes-or-no-p msg)) (end-of-line) (setq eline (point)) (beginning-of-line) (setq old-code (regexp-quote old-code)) (while (string-match "\\\\ " old-code spos) (setq new-old-code (concat new-old-code (substring old-code spos (match-beginning 0)) "\\ *")) (setq spos (match-end 0))) (setq new-old-code (concat new-old-code (substring old-code spos))) (remove-text-properties bline eline '(composition nil)) (when (re-search-forward new-old-code eline t) (replace-match new-code nil t))))))) (defun haskell-lint-finish-hook (buf msg) "Function, that is executed at the end of HLint or scan execution" (if haskell-checkers-replace-with-suggestions (haskell-lint-replace-suggestions) (next-error 1 t))) (defun haskell-scan-finish-hook (buf msg) "Function, that is executed at the end of haskell-scan execution" (next-error 1 t)) (defun haskell-scan-make-command (file) "Generates command line for scan" (concat haskell-scan-command " " haskell-scan-options " \"" file "\"")) (defun haskell-lint-make-command (file) "Generates command line for scan" (concat haskell-lint-command " \"/" file "/\"" " " haskell-lint-options)) (defmacro haskell-checkers-setup (type name) "Performs setup of corresponding checker. Receives two arguments: type - checker's type (lint or scan) that is expanded into functions and hooks names name - user visible name for this mode" (let ((nm (concat "haskell-" (symbol-name type)))) `(progn ;;;###autoload (defvar ,(intern (concat nm "-setup-hook")) nil ,(concat "Hook, that will executed before running " name)) (defun ,(intern (concat nm "-process-setup")) () "Setup compilation variables and buffer for `hlint'." (run-hooks ',(intern (concat nm "-setup-hook")))) ;;;###autoload (define-compilation-mode ,(intern (concat nm "-mode")) ,name ,(concat "Mode to check Haskell source code using " name) (set (make-local-variable 'compilation-process-setup-function) ',(intern (concat nm "-process-setup"))) (set (make-local-variable 'compilation-disable-input) t) (set (make-local-variable 'compilation-scroll-output) nil) (set (make-local-variable 'compilation-finish-functions) (list ',(intern (concat nm "-finish-hook"))))) ;;;###autoload (defun ,(intern nm) () ,(concat "Run " name " for current buffer with haskell source") (interactive) (save-some-buffers haskell-checkers-save-files) (compilation-start (,(intern (concat nm "-make-command")) buffer-file-name) ',(intern (concat nm "-mode"))))) )) (haskell-checkers-setup lint "HLint") (haskell-checkers-setup scan "HScan") (provide 'haskell-checkers) ;;; haskell-checkers.el ends here haskell-mode-13.14.2/haskell-collapse.el000066400000000000000000000043231253441665600200120ustar00rootroot00000000000000;;; haskell-collapse.el --- Collapse expressions ;; Copyright (c) 2014 Chris Done. All rights reserved. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: (define-button-type 'haskell-collapse-toggle-button 'action 'haskell-collapse-toggle-button-callback 'follow-link t 'help-echo "Click to expand…") (defun haskell-collapse (beg end) "Collapse." (interactive "r") (goto-char end) (let ((break nil)) (while (and (not break) (search-backward-regexp "[[({]" beg t 1)) (unless (elt (syntax-ppss) 3) (let ((orig (point))) (haskell-collapse-sexp) (goto-char orig) (forward-char -1) (when (= (point) orig) (setq break t))))))) (defun haskell-collapse-sexp () "Collapse the sexp starting at point." (let ((beg (point))) (forward-sexp) (let ((end (point))) (let ((o (make-overlay beg end))) (overlay-put o 'invisible t) (let ((start (point))) (insert "…") (let ((button (make-text-button start (point) :type 'haskell-collapse-toggle-button))) (button-put button 'overlay o) (button-put button 'hide-on-click t))))))) (defun haskell-collapse-toggle-button-callback (btn) "The callback to toggle the overlay visibility." (let ((overlay (button-get btn 'overlay))) (when overlay (overlay-put overlay 'invisible (not (overlay-get overlay 'invisible))))) (button-put btn 'invisible t) (delete-region (button-start btn) (button-end btn))) (provide 'haskell-collapse) haskell-mode-13.14.2/haskell-commands.el000066400000000000000000001265721253441665600200240ustar00rootroot00000000000000;;; haskell-commands.el --- Commands that can be run on the process ;;; Commentary: ;;; This module provides varoius `haskell-mode' and `haskell-interactive-mode' ;;; specific commands such as show type signature, show info, haskell process ;;; commands and etc. ;; Copyright (c) 2014 Chris Done. All rights reserved. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: (require 'cl-lib) (require 'etags) (require 'haskell-compat) (require 'haskell-process) (require 'haskell-font-lock) (require 'haskell-interactive-mode) (require 'haskell-session) (require 'haskell-presentation-mode) (require 'highlight-uses-mode) (defvar haskell-utils-async-post-command-flag nil "Non-nil means some commands were triggered during async function execution.") (make-variable-buffer-local 'haskell-utils-async-post-command-flag) ;;;###autoload (defun haskell-process-restart () "Restart the inferior Haskell process." (interactive) (haskell-process-reset (haskell-interactive-process)) (haskell-process-set (haskell-interactive-process) 'command-queue nil) (haskell-process-start (haskell-interactive-session))) (defun haskell-process-start (session) "Start the inferior Haskell process with a given SESSION. You can create new session using function `haskell-session-make'." (let ((existing-process (get-process (haskell-session-name (haskell-interactive-session))))) (when (processp existing-process) (haskell-interactive-mode-echo session "Restarting process ...") (haskell-process-set (haskell-session-process session) 'is-restarting t) (delete-process existing-process))) (let ((process (or (haskell-session-process session) (haskell-process-make (haskell-session-name session)))) (old-queue (haskell-process-get (haskell-session-process session) 'command-queue))) (haskell-session-set-process session process) (haskell-process-set-session process session) (haskell-process-set-cmd process nil) (haskell-process-set (haskell-session-process session) 'is-restarting nil) (let ((default-directory (haskell-session-cabal-dir session)) (log-and-command (haskell-process-compute-process-log-and-command session (haskell-process-type)))) (haskell-session-pwd session) (haskell-process-set-process process (progn (haskell-process-log (propertize (format "%S" log-and-command))) (apply #'start-process (cdr log-and-command))))) (progn (set-process-sentinel (haskell-process-process process) 'haskell-process-sentinel) (set-process-filter (haskell-process-process process) 'haskell-process-filter)) (haskell-process-send-startup process) (unless (eq 'cabal-repl (haskell-process-type)) ;; "cabal repl" sets the proper CWD (haskell-process-change-dir session process (haskell-session-current-dir session))) (haskell-process-set process 'command-queue (append (haskell-process-get (haskell-session-process session) 'command-queue) old-queue)) process)) (defun haskell-process-send-startup (process) "Send the necessary start messages to haskell PROCESS." (haskell-process-queue-command process (make-haskell-command :state process :go (lambda (process) (haskell-process-send-string process ":set prompt \"\\4\"") (haskell-process-send-string process "Prelude.putStrLn \"\"") (haskell-process-send-string process ":set -v1")) :live (lambda (process buffer) (when (haskell-process-consume process "^\*\*\* WARNING: \\(.+\\) is writable by someone else, IGNORING!$") (let ((path (match-string 1 buffer))) (haskell-session-modify (haskell-process-session process) 'ignored-files (lambda (files) (cl-remove-duplicates (cons path files) :test 'string=))) (haskell-interactive-mode-compile-warning (haskell-process-session process) (format "GHCi is ignoring: %s (run M-x haskell-process-unignore)" path))))) :complete (lambda (process _) (haskell-interactive-mode-echo (haskell-process-session process) (concat (nth (random (length haskell-process-greetings)) haskell-process-greetings) (when haskell-process-show-debug-tips " If I break, you can: 1. Restart: M-x haskell-process-restart 2. Configure logging: C-h v haskell-process-log (useful for debugging) 3. General config: M-x customize-mode 4. Hide these tips: C-h v haskell-process-show-debug-tips"))))))) (defun haskell-commands-process () "Get the Haskell session, throws an error if not available." (or (haskell-session-process (haskell-session-maybe)) (error "No Haskell session/process associated with this buffer. Maybe run M-x haskell-session-change?"))) ;;;###autoload (defun haskell-process-clear () "Clear the current process." (interactive) (haskell-process-reset (haskell-commands-process)) (haskell-process-set (haskell-commands-process) 'command-queue nil)) ;;;###autoload (defun haskell-process-interrupt () "Interrupt the process (SIGINT)." (interactive) (interrupt-process (haskell-process-process (haskell-commands-process)))) (defun haskell-process-reload-with-fbytecode (process module-buffer) "Query a PROCESS to reload MODULE-BUFFER with -fbyte-code set. Restores -fobject-code after reload finished. MODULE-BUFFER is the actual Emacs buffer of the module being loaded." (haskell-process-queue-without-filters process ":set -fbyte-code") (haskell-process-touch-buffer process module-buffer) (haskell-process-queue-without-filters process ":reload") (haskell-process-queue-without-filters process ":set -fobject-code")) ;;;###autoload (defun haskell-process-touch-buffer (process buffer) "Query PROCESS to `:!touch` BUFFER's file. Use to update mtime on BUFFER's file." (interactive) (haskell-process-queue-command process (make-haskell-command :state (cons process buffer) :go (lambda (state) (haskell-process-send-string (car state) (format ":!%s %s" "touch" (shell-quote-argument (buffer-file-name (cdr state)))))) :complete (lambda (state _) (with-current-buffer (cdr state) (clear-visited-file-modtime)))))) (defvar url-http-response-status) (defvar url-http-end-of-headers) (defun haskell-process-hayoo-ident (ident) ;; FIXME Obsolete doc string, CALLBACK is not used. "Hayoo for IDENT, return a list of modules asyncronously through CALLBACK." ;; We need a real/simulated closure, because otherwise these ;; variables will be unbound when the url-retrieve callback is ;; called. ;; TODO: Remove when this code is converted to lexical bindings by ;; default (Emacs 24.1+) (let ((url (format haskell-process-hayoo-query-url (url-hexify-string ident)))) (with-current-buffer (url-retrieve-synchronously url) (if (= 200 url-http-response-status) (progn (goto-char url-http-end-of-headers) (let* ((res (json-read)) (results (assoc-default 'result res))) ;; TODO: gather packages as well, and when we choose a ;; given import, check that we have the package in the ;; cabal file as well. (cl-mapcan (lambda (r) ;; append converts from vector -> list (append (assoc-default 'resultModules r) nil)) results))) (warn "HTTP error %s fetching %s" url-http-response-status url))))) (defun haskell-process-hoogle-ident (ident) "Hoogle for IDENT, return a list of modules." (with-temp-buffer (let ((hoogle-error (call-process "hoogle" nil t nil "search" "--exact" ident))) (goto-char (point-min)) (unless (or (/= 0 hoogle-error) (looking-at "^No results found") (looking-at "^package ")) (while (re-search-forward "^\\([^ ]+\\).*$" nil t) (replace-match "\\1" nil nil)) (cl-remove-if (lambda (a) (string= "" a)) (split-string (buffer-string) "\n")))))) (defun haskell-process-haskell-docs-ident (ident) "Search with haskell-docs for IDENT, return a list of modules." (cl-remove-if-not (lambda (a) (string-match "^[[:upper:]][[:alnum:]_'.]+$" a)) (split-string (with-output-to-string (with-current-buffer standard-output (call-process "haskell-docs" nil ; no infile t ; output to current buffer (that is string) nil ; do not redisplay "--modules" ident))) "\n"))) (defun haskell-process-import-modules (process modules) "Query PROCESS `:m +' command to import MODULES." (when haskell-process-auto-import-loaded-modules (haskell-process-queue-command process (make-haskell-command :state (cons process modules) :go (lambda (state) (haskell-process-send-string (car state) (format ":m + %s" (mapconcat 'identity (cdr state) " ")))))))) ;;;###autoload (defun haskell-describe (ident) "Describe the given identifier IDENT." (interactive (list (read-from-minibuffer "Describe identifier: " (haskell-ident-at-point)))) (let ((results (read (shell-command-to-string (concat "haskell-docs --sexp " ident))))) (help-setup-xref (list #'haskell-describe ident) (called-interactively-p 'interactive)) (save-excursion (with-help-window (help-buffer) (with-current-buffer (help-buffer) (if results (cl-loop for result in results do (insert (propertize ident 'font-lock-face '((:inherit font-lock-type-face :underline t))) " is defined in " (let ((module (cadr (assoc 'module result)))) (if module (concat module " ") "")) (cadr (assoc 'package result)) "\n\n") do (let ((type (cadr (assoc 'type result)))) (when type (insert (haskell-fontify-as-mode type 'haskell-mode) "\n"))) do (let ((args (cadr (assoc 'type results)))) (cl-loop for arg in args do (insert arg "\n")) (insert "\n")) do (insert (cadr (assoc 'documentation result))) do (insert "\n\n")) (insert "No results for " ident))))))) ;;;###autoload (defun haskell-rgrep (&optional prompt) "Grep the effective project for the symbol at point. Very useful for codebase navigation. Prompts for an arbitrary regexp given a prefix arg PROMPT." (interactive "P") (let ((sym (if prompt (read-from-minibuffer "Look for: ") (haskell-ident-at-point)))) (rgrep sym "*.hs" ;; TODO: common Haskell extensions. (haskell-session-current-dir (haskell-interactive-session))))) ;;;###autoload (defun haskell-process-do-info (&optional prompt-value) "Print info on the identifier at point. If PROMPT-VALUE is non-nil, request identifier via mini-buffer." (interactive "P") (let ((at-point (haskell-ident-at-point))) (when (or prompt-value at-point) (let* ((ident (replace-regexp-in-string "^!\\([A-Z_a-z]\\)" "\\1" (if prompt-value (read-from-minibuffer "Info: " at-point) at-point))) (modname (unless prompt-value (haskell-utils-parse-import-statement-at-point))) (command (cond (modname (format ":browse! %s" modname)) ((string= ident "") ; For the minibuffer input case nil) (t (format (if (string-match "^[a-zA-Z_]" ident) ":info %s" ":info (%s)") (or ident at-point)))))) (when command (haskell-process-show-repl-response command)))))) ;;;###autoload (defun haskell-process-do-type (&optional insert-value) ;; FIXME insert value functionallity seems to be missing. "Print the type of the given expression. Given INSERT-VALUE prefix indicates that result type signature should be inserted." (interactive "P") (if insert-value (haskell-process-insert-type) (let* ((expr (if (use-region-p) (buffer-substring-no-properties (region-beginning) (region-end)) (haskell-ident-at-point))) (expr-okay (and expr (not (string-match-p "\\`[[:space:]]*\\'" expr)) (not (string-match-p "\n" expr))))) ;; No newlines in expressions, and surround with parens if it ;; might be a slice expression (when expr-okay (haskell-process-show-repl-response (format (if (or (string-match-p "\\`(" expr) (string-match-p "\\`[_[:alpha:]]" expr)) ":type %s" ":type (%s)") expr)))))) ;;;###autoload (defun haskell-mode-jump-to-def-or-tag (&optional next-p) ;; FIXME NEXT-P arg is not used "Jump to the definition. Jump to definition of identifier at point by consulting GHCi, or tag table as fallback. Remember: If GHCi is busy doing something, this will delay, but it will always be accurate, in contrast to tags, which always work but are not always accurate. If the definition or tag is found, the location from which you jumped will be pushed onto `xref--marker-ring', so you can return to that position with `xref-pop-marker-stack'." (interactive "P") (let ((initial-loc (point-marker)) (loc (haskell-mode-find-def (haskell-ident-at-point)))) (if loc (haskell-mode-handle-generic-loc loc) (call-interactively 'haskell-mode-tag-find)) (unless (equal initial-loc (point-marker)) (with-current-buffer (marker-buffer initial-loc) (save-excursion (goto-char initial-loc) (set-mark-command nil) ;; Store position for return with `xref-pop-marker-stack' (xref-push-marker-stack)))))) ;;;###autoload (defun haskell-mode-goto-loc () "Go to the location of the thing at point. Requires the :loc-at command from GHCi." (interactive) (let ((loc (haskell-mode-loc-at))) (when loc (haskell-mode-goto-span loc)))) (defun haskell-mode-goto-span (span) "Jump to the SPAN, whatever file and line and column it needs to get there." (xref-push-marker-stack) (find-file (expand-file-name (plist-get span :path) (haskell-session-cabal-dir (haskell-interactive-session)))) (goto-char (point-min)) (forward-line (1- (plist-get span :start-line))) (forward-char (plist-get span :start-col))) (defun haskell-process-insert-type () "Get the identifer at the point and insert its type. Use GHCi's :type if it's possible." (let ((ident (haskell-ident-at-point))) (when ident (let ((process (haskell-interactive-process)) (query (format (if (string-match "^[_[:lower:][:upper:]]" ident) ":type %s" ":type (%s)") ident))) (haskell-process-queue-command process (make-haskell-command :state (list process query (current-buffer)) :go (lambda (state) (haskell-process-send-string (nth 0 state) (nth 1 state))) :complete (lambda (state response) (cond ;; TODO: Generalize this into a function. ((or (string-match "^Top level" response) (string-match "^" response)) (message response)) (t (with-current-buffer (nth 2 state) (goto-char (line-beginning-position)) (insert (format "%s\n" (replace-regexp-in-string "\n$" "" response))))))))))))) (defun haskell-mode-find-def (ident) ;; TODO Check if it possible to exploit `haskell-process-do-info' "Find definition location of identifier IDENT. Uses the GHCi process to find the location. Returns nil if it can't find the identifier or the identifier isn't a string. Returns: (library ) (file ) (module ) nil" (when (stringp ident) (let ((reply (haskell-process-queue-sync-request (haskell-interactive-process) (format (if (string-match "^[a-zA-Z_]" ident) ":info %s" ":info (%s)") ident)))) (let ((match (string-match "-- Defined \\(at\\|in\\) \\(.+\\)$" reply))) (when match (let ((defined (match-string 2 reply))) (let ((match (string-match "\\(.+?\\):\\([0-9]+\\):\\([0-9]+\\)$" defined))) (cond (match (list 'file (expand-file-name (match-string 1 defined) (haskell-session-current-dir (haskell-interactive-session))) (string-to-number (match-string 2 defined)) (string-to-number (match-string 3 defined)))) (t (let ((match (string-match "`\\(.+?\\):\\(.+?\\)'$" defined))) (if match (list 'library (match-string 1 defined) (match-string 2 defined)) (let ((match (string-match "`\\(.+?\\)'$" defined))) (if match (list 'module (match-string 1 defined))))))))))))))) ;;;###autoload (defun haskell-mode-jump-to-def (ident) "Jump to definition of identifier IDENT at point." (interactive (list (haskell-ident-at-point))) (let ((loc (haskell-mode-find-def ident))) (when loc (haskell-mode-handle-generic-loc loc)))) (defun haskell-mode-handle-generic-loc (loc) "Either jump to or echo a generic location LOC. Either a file or a library." (cl-case (car loc) (file (haskell-mode-jump-to-loc (cdr loc))) (library (message "Defined in `%s' (%s)." (elt loc 2) (elt loc 1))) (module (message "Defined in `%s'." (elt loc 1))))) (defun haskell-mode-loc-at () "Get the location at point. Requires the :loc-at command from GHCi." (let ((pos (or (when (region-active-p) (cons (region-beginning) (region-end))) (haskell-spanable-pos-at-point) (cons (point) (point))))) (when pos (let ((reply (haskell-process-queue-sync-request (haskell-interactive-process) (save-excursion (format ":loc-at %s %d %d %d %d %s" (buffer-file-name) (progn (goto-char (car pos)) (line-number-at-pos)) (1+ (current-column)) ;; GHC uses 1-based columns. (progn (goto-char (cdr pos)) (line-number-at-pos)) (1+ (current-column)) ;; GHC uses 1-based columns. (buffer-substring-no-properties (car pos) (cdr pos))))))) (if reply (if (string-match "\\(.*?\\):(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\))" reply) (list :path (match-string 1 reply) :start-line (string-to-number (match-string 2 reply)) ;; ;; GHC uses 1-based columns. :start-col (1- (string-to-number (match-string 3 reply))) :end-line (string-to-number (match-string 4 reply)) ;; GHC uses 1-based columns. :end-col (1- (string-to-number (match-string 5 reply)))) (error (propertize reply 'face 'compilation-error))) (error (propertize "No reply. Is :loc-at supported?" 'face 'compilation-error))))))) ;;;###autoload (defun haskell-process-cd (&optional not-interactive) ;; FIXME optional arg is not used "Change directory." (interactive) (let* ((session (haskell-interactive-session)) (dir (haskell-session-pwd session t))) (haskell-process-log (propertize (format "Changing directory to %s ...\n" dir) 'face font-lock-comment-face)) (haskell-process-change-dir session (haskell-interactive-process) dir))) (defun haskell-session-pwd (session &optional change) "Prompt for the current directory. Return current working directory for SESSION. Optional CHANGE argument makes user to choose new working directory for SESSION. In this case new working directory path will be returned." (or (unless change (haskell-session-get session 'current-dir)) (progn (haskell-session-set-current-dir session (haskell-utils-read-directory-name (if change "Change directory: " "Set current directory: ") (or (haskell-session-get session 'current-dir) (haskell-session-get session 'cabal-dir) (if (buffer-file-name) (file-name-directory (buffer-file-name)) "~/")))) (haskell-session-get session 'current-dir)))) (defun haskell-process-change-dir (session process dir) "Change SESSION's current directory. Query PROCESS to `:cd` to directory DIR." (haskell-process-queue-command process (make-haskell-command :state (list session process dir) :go (lambda (state) (haskell-process-send-string (cadr state) (format ":cd %s" (cl-caddr state)))) :complete (lambda (state _) (haskell-session-set-current-dir (car state) (cl-caddr state)) (haskell-interactive-mode-echo (car state) (format "Changed directory: %s" (cl-caddr state))))))) ;;;###autoload (defun haskell-process-cabal-macros () "Send the cabal macros string." (interactive) (haskell-process-queue-without-filters (haskell-interactive-process) ":set -optP-include -optPdist/build/autogen/cabal_macros.h")) (defun haskell-process-do-try-info (sym) "Get info of SYM and echo in the minibuffer." (let ((process (haskell-interactive-process))) (haskell-process-queue-command process (make-haskell-command :state (cons process sym) :go (lambda (state) (haskell-process-send-string (car state) (if (string-match "^[A-Za-z_]" (cdr state)) (format ":info %s" (cdr state)) (format ":info (%s)" (cdr state))))) :complete (lambda (state response) (unless (or (string-match "^Top level" response) (string-match "^" response)) (haskell-mode-message-line response))))))) (defun haskell-process-do-try-type (sym) "Get type of SYM and echo in the minibuffer." (let ((process (haskell-interactive-process))) (haskell-process-queue-command process (make-haskell-command :state (cons process sym) :go (lambda (state) (haskell-process-send-string (car state) (if (string-match "^[A-Za-z_]" (cdr state)) (format ":type %s" (cdr state)) (format ":type (%s)" (cdr state))))) :complete (lambda (state response) (unless (or (string-match "^Top level" response) (string-match "^" response)) (haskell-mode-message-line response))))))) ;;;###autoload (defun haskell-mode-show-type-at (&optional insert-value) "Show type of the thing at point or within active region asynchronously. This function requires GHCi-ng and `:set +c` option enabled by default (please follow GHCi-ng README available at URL `https://github.com/chrisdone/ghci-ng'). \\ To make this function works sometimes you need to load the file in REPL first using command `haskell-process-load-or-reload' bound to \\[haskell-process-load-or-reload]. Optional argument INSERT-VALUE indicates that recieved type signature should be inserted (but only if nothing happened since function invocation)." (interactive "P") (let* ((pos (haskell-utils-capture-expr-bounds)) (req (haskell-utils-compose-type-at-command pos)) (process (haskell-interactive-process)) (buf (current-buffer)) (pos-reg (cons pos (region-active-p)))) (haskell-process-queue-command process (make-haskell-command :state (list process req buf insert-value pos-reg) :go (lambda (state) (let* ((prc (car state)) (req (nth 1 state))) (haskell-utils-async-watch-changes) (haskell-process-send-string prc req))) :complete (lambda (state response) (let* ((init-buffer (nth 2 state)) (insert-value (nth 3 state)) (pos-reg (nth 4 state)) (wrap (cdr pos-reg)) (min-pos (caar pos-reg)) (max-pos (cdar pos-reg)) (sig (haskell-utils-reduce-string response)) (res-type (haskell-utils-parse-repl-response sig))) (cl-case res-type ;; neither popup presentation buffer ;; nor insert response in error case ('unknown-command (message (concat "This command requires GHCi-ng. " "Please read command description for details."))) ('option-missing (message (concat "Could not infer type signature. " "You need to load file first. " "Also :set +c is required. " "Please read command description for details."))) ('interactive-error (message "Wrong REPL response: %s" sig)) (otherwise (if insert-value ;; Only insert type signature and do not present it (if (= (length haskell-utils-async-post-command-flag) 1) (if wrap ;; Handle region case (progn (deactivate-mark) (save-excursion (delete-region min-pos max-pos) (goto-char min-pos) (insert (concat "(" sig ")")))) ;; Non-region cases (haskell-utils-insert-type-signature sig)) ;; Some commands registered, prevent insertion (let* ((rev (reverse haskell-utils-async-post-command-flag)) (cs (format "%s" (cdr rev)))) (message (concat "Type signature insertion was prevented. " "These commands were registered:" cs)))) ;; Present the result only when response is valid and not asked ;; to insert result (haskell-utils-echo-or-present response))) (haskell-utils-async-stop-watching-changes init-buffer)))))))) ;;;###autoload (defun haskell-process-generate-tags (&optional and-then-find-this-tag) "Regenerate the TAGS table. If optional AND-THEN-FIND-THIS-TAG argument is present it is used with function `xref-find-definitions' after new table was generated." (interactive) (let ((process (haskell-interactive-process))) (haskell-process-queue-command process (make-haskell-command :state (cons process and-then-find-this-tag) :go (lambda (state) (if (eq system-type 'windows-nt) (haskell-process-send-string (car state) (format ":!hasktags --output=\"%s\\TAGS\" -x -e \"%s\"" (haskell-session-cabal-dir (haskell-process-session (car state))) (haskell-session-cabal-dir (haskell-process-session (car state))))) (haskell-process-send-string (car state) (format ":!cd %s && %s | %s" (haskell-session-cabal-dir (haskell-process-session (car state))) "find . -name '*.hs' -print0 -or -name '*.lhs' -print0 -or -name '*.hsc' -print0" "xargs -0 hasktags -e -x")))) :complete (lambda (state response) (when (cdr state) (let ((session-tags (haskell-session-tags-filename (haskell-process-session (car state))))) (add-to-list 'tags-table-list session-tags) (setq tags-file-name nil)) (xref-find-definitions (cdr state))) (haskell-mode-message-line "Tags generated.")))))) (defun haskell-process-add-cabal-autogen () "Add cabal's autogen dir to the GHCi search path. Add /dist/build/autogen/ to GHCi seatch path. This allows modules such as 'Path_...', generated by cabal, to be loaded by GHCi." (unless (eq 'cabal-repl (haskell-process-type)) ;; redundant with "cabal repl" (let* ((session (haskell-interactive-session)) (cabal-dir (haskell-session-cabal-dir session)) (ghci-gen-dir (format "%sdist/build/autogen/" cabal-dir))) (haskell-process-queue-without-filters (haskell-interactive-process) (format ":set -i%s" ghci-gen-dir))))) ;;;###autoload (defun haskell-process-unignore () "Unignore any ignored files. Do not ignore files that were specified as being ignored by the inferior GHCi process." (interactive) (let ((session (haskell-interactive-session)) (changed nil)) (if (null (haskell-session-get session 'ignored-files)) (message "Nothing to unignore!") (cl-loop for file in (haskell-session-get session 'ignored-files) do (cl-case (read-event (propertize (format "Set permissions? %s (y, n, v: stop and view file)" file) 'face 'minibuffer-prompt)) (?y (haskell-process-unignore-file session file) (setq changed t)) (?v (find-file file) (cl-return)))) (when (and changed (y-or-n-p "Restart GHCi process now? ")) (haskell-process-restart))))) ;;;###autoload (defun haskell-session-change-target (target) "Set the build TARGET for cabal REPL." (interactive "sNew build target:") (let* ((session haskell-session) (old-target (haskell-session-get session 'target))) (when session (haskell-session-set-target session target) (when (and (not (string= old-target target)) (y-or-n-p "Target changed, restart haskell process?")) (haskell-process-start session))))) ;;;###autoload (defun haskell-mode-stylish-buffer () "Apply stylish-haskell to the current buffer." (interactive) (let ((column (current-column)) (line (line-number-at-pos))) (haskell-mode-buffer-apply-command "stylish-haskell") (goto-char (point-min)) (forward-line (1- line)) (goto-char (+ column (point))))) (defun haskell-mode-buffer-apply-command (cmd) "Execute shell command CMD with current buffer as input and output. Use buffer as input and replace the whole buffer with the output. If CMD fails the buffer remains unchanged." (set-buffer-modified-p t) (let* ((chomp (lambda (str) (while (string-match "\\`\n+\\|^\\s-+\\|\\s-+$\\|\n+\\'" str) (setq str (replace-match "" t t str))) str)) (errout (lambda (fmt &rest args) (let* ((warning-fill-prefix " ")) (display-warning cmd (apply 'format fmt args) :warning)))) (filename (buffer-file-name (current-buffer))) (cmd-prefix (replace-regexp-in-string " .*" "" cmd)) (tmp-file (make-temp-file cmd-prefix)) (err-file (make-temp-file cmd-prefix)) (default-directory (if (and (boundp 'haskell-session) haskell-session) (haskell-session-cabal-dir haskell-session) default-directory)) (errcode (with-temp-file tmp-file (call-process cmd filename (list (current-buffer) err-file) nil))) (stderr-output (with-temp-buffer (insert-file-contents err-file) (funcall chomp (buffer-substring-no-properties (point-min) (point-max))))) (stdout-output (with-temp-buffer (insert-file-contents tmp-file) (buffer-substring-no-properties (point-min) (point-max))))) (if (string= "" stderr-output) (if (string= "" stdout-output) (message "Error: %s produced no output, leaving buffer alone" cmd) (save-restriction (widen) ;; command successful, insert file with replacement to preserve ;; markers. (insert-file-contents tmp-file nil nil nil t))) (progn ;; non-null stderr, command must have failed (message "Error: %s ended with errors, leaving buffer alone" cmd) ;; use (warning-minimum-level :debug) to see this (display-warning cmd stderr-output :debug))) (delete-file tmp-file) (delete-file err-file))) ;;;###autoload (defun haskell-mode-find-uses () "Find use cases of the identifier at point and highlight them all." (interactive) (let ((spans (haskell-mode-uses-at))) (unless (null spans) (highlight-uses-mode 1) (cl-loop for span in spans do (haskell-mode-make-use-highlight span))))) (defun haskell-mode-make-use-highlight (span) "Make a highlight overlay at the given SPAN." (save-window-excursion (save-excursion (haskell-mode-goto-span span) (save-excursion (highlight-uses-mode-highlight (progn (goto-char (point-min)) (forward-line (1- (plist-get span :start-line))) (forward-char (plist-get span :start-col)) (point)) (progn (goto-char (point-min)) (forward-line (1- (plist-get span :end-line))) (forward-char (plist-get span :end-col)) (point))))))) (defun haskell-mode-uses-at () "Get the locations of use cases for the ident at point. Requires the :uses command from GHCi." (let ((pos (or (when (region-active-p) (cons (region-beginning) (region-end))) (haskell-ident-pos-at-point) (cons (point) (point))))) (when pos (let ((reply (haskell-process-queue-sync-request (haskell-interactive-process) (save-excursion (format ":uses %s %d %d %d %d %s" (buffer-file-name) (progn (goto-char (car pos)) (line-number-at-pos)) (1+ (current-column)) ;; GHC uses 1-based columns. (progn (goto-char (cdr pos)) (line-number-at-pos)) (1+ (current-column)) ;; GHC uses 1-based columns. (buffer-substring-no-properties (car pos) (cdr pos))))))) (if reply (let ((lines (split-string reply "\n" t))) (cl-remove-if #'null (mapcar (lambda (line) (if (string-match "\\(.*?\\):(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\))" line) (list :path (match-string 1 line) :start-line (string-to-number (match-string 2 line)) ;; ;; GHC uses 1-based columns. :start-col (1- (string-to-number (match-string 3 line))) :end-line (string-to-number (match-string 4 line)) ;; GHC uses 1-based columns. :end-col (1- (string-to-number (match-string 5 line)))) (error (propertize line 'face 'compilation-error)))) lines))) (error (propertize "No reply. Is :uses supported?" 'face 'compilation-error))))))) (defun haskell-utils-capture-expr-bounds () "Capture position bounds of expression at point. If there is an active region then it returns region bounds. Otherwise it uses `haskell-spanable-pos-at-point` to capture identifier bounds. If latter function returns NIL this function will return cons cell where min and max positions both are equal to point." (or (when (region-active-p) (cons (region-beginning) (region-end))) (haskell-spanable-pos-at-point) (cons (point) (point)))) (defun haskell-utils-compose-type-at-command (pos) "Prepare :type-at command to be send to haskell process. POS is a cons cell containing min and max positions, i.e. target expression bounds." (replace-regexp-in-string "\n$" "" (format ":type-at %s %d %d %d %d %s" (buffer-file-name) (progn (goto-char (car pos)) (line-number-at-pos)) (1+ (current-column)) (progn (goto-char (cdr pos)) (line-number-at-pos)) (1+ (current-column)) (buffer-substring-no-properties (car pos) (cdr pos))))) (defun haskell-utils-insert-type-signature (signature) "Insert type signature. In case of active region is present, wrap it by parentheses and append SIGNATURE to original expression. Otherwise tries to carefully insert SIGNATURE above identifier at point. Removes newlines and extra whitespace in signature before insertion." (let* ((ident-pos (or (haskell-ident-pos-at-point) (cons (point) (point)))) (min-pos (car ident-pos)) (sig (haskell-utils-reduce-string signature))) (save-excursion (goto-char min-pos) (let ((col (current-column))) (insert sig "\n") (indent-to col))))) (defun haskell-utils-echo-or-present (msg) "Present message in some manner depending on configuration. If variable `haskell-process-use-presentation-mode' is NIL it will output modified message MSG to echo area." (if haskell-process-use-presentation-mode (let ((session (haskell-process-session (haskell-interactive-process)))) (haskell-present session msg)) (let ((m (haskell-utils-reduce-string msg))) (message m)))) (defun haskell-utils-async-update-post-command-flag () "A special hook which collects triggered commands during async execution. This hook pushes value of variable `this-command' to flag variable `haskell-utils-async-post-command-flag'." (let* ((cmd this-command) (updated-flag (cons cmd haskell-utils-async-post-command-flag))) (setq haskell-utils-async-post-command-flag updated-flag))) (defun haskell-utils-async-watch-changes () "Watch for triggered commands during async operation execution. Resets flag variable `haskell-utils-async-update-post-command-flag' to NIL. By chanhges it is assumed that nothing happened, e.g. nothing was inserted in buffer, point was not moved, etc. To collect data `post-command-hook' is used." (setq haskell-utils-async-post-command-flag nil) (add-hook 'post-command-hook #'haskell-utils-async-update-post-command-flag nil t)) (defun haskell-utils-async-stop-watching-changes (buffer) "Clean up after async operation finished. This function takes care about cleaning up things made by `haskell-utils-async-watch-changes'. The BUFFER argument is a buffer where `post-command-hook' should be disabled. This is neccessary, because it is possible that user will change buffer during async function execusion." (with-current-buffer buffer (setq haskell-utils-async-post-command-flag nil) (remove-hook 'post-command-hook #'haskell-utils-async-update-post-command-flag t))) (defun haskell-utils-reduce-string (s) "Remove newlines ans extra whitespace from S. Removes all extra whitespace at the beginning of each line leaving only single one. Then removes all newlines." (let ((s_ (replace-regexp-in-string "^\s+" " " s))) (replace-regexp-in-string "\n" "" s_))) (defun haskell-utils-parse-repl-response (r) "Parse response R from REPL and return special kind of result. The result is response string itself with speacial property response-type added. This property could be of the following: + unknown-command + option-missing + interactive-error + success" (let ((first-line (car (split-string r "\n")))) (cond ((string-match-p "^unknown command" first-line) 'unknown-command) ((string-match-p "^Couldn't guess that module name. Does it exist?" first-line) 'option-missing) ((string-match-p "^:" first-line) 'interactive-error) (t 'success)))) (provide 'haskell-commands) ;;; haskell-commands.el ends here haskell-mode-13.14.2/haskell-compat.el000066400000000000000000000044771253441665600175050ustar00rootroot00000000000000;;; haskell-compat.el --- legacy/compatibility backports for haskell-mode ;; ;; Filename: haskell-compat.el ;; Description: legacy/compatibility backports for haskell-mode ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;;; Code: (require 'etags) (require 'ring) (require 'outline) (require 'xref nil t) (eval-when-compile (setq byte-compile-warnings '(not cl-functions obsolete))) ;; Missing in Emacs23, stolen from Emacs24's `subr.el' (unless (fboundp 'process-live-p) (defun process-live-p (process) "Returns non-nil if PROCESS is alive. A process is considered alive if its status is `run', `open', `listen', `connect' or `stop'." (memq (process-status process) '(run open listen connect stop)))) ;; Cross-referencing commands have been replaced since Emacs 25.1. ;; These aliases are required to provide backward compatibility. (unless (fboundp 'xref-push-marker-stack) (defalias 'xref-pop-marker-stack 'pop-tag-mark) (defun xref-push-marker-stack () "Add point to the marker stack." (ring-insert find-tag-marker-ring (point-marker)))) (unless (fboundp 'outline-hide-sublevels) (defalias 'outline-hide-sublevels 'hide-sublevels)) (unless (fboundp 'outline-show-subtree) (defalias 'outline-show-subtree 'show-subtree)) (unless (fboundp 'outline-hide-sublevels) (defalias 'outline-hide-sublevels 'hide-sublevels)) (unless (fboundp 'outline-show-subtree) (defalias 'outline-show-subtree 'show-subtree)) (unless (fboundp 'xref-find-definitions) (defun xref-find-definitions (ident) (let ((next-p (and (boundp 'xref-prompt-for-identifier) xref-prompt-for-identifier))) (find-tag ident next-p)))) (provide 'haskell-compat) ;;; haskell-compat.el ends here haskell-mode-13.14.2/haskell-compile.el000066400000000000000000000144141253441665600176420ustar00rootroot00000000000000;;; haskell-compile.el --- Haskell/GHC compilation sub-mode ;; Copyright (C) 2013 Herbert Valerio Riedel ;; Author: Herbert Valerio Riedel ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; Simple GHC-centric compilation sub-mode; see info node ;; `(haskell-mode)compilation' for more information ;;; Code: (require 'compile) (require 'haskell-cabal) (defgroup haskell-compile nil "Settings for Haskell compilation mode" :link '(custom-manual "(haskell-mode)compilation") :group 'haskell) (defcustom haskell-compile-cabal-build-command "cd %s && cabal build --ghc-option=-ferror-spans" "Default build command to use for `haskell-cabal-build' when a cabal file is detected. The `%s' placeholder is replaced by the cabal package top folder." :group 'haskell-compile :type 'string) (defcustom haskell-compile-cabal-build-alt-command "cd %s && cabal clean -s && cabal build --ghc-option=-ferror-spans" "Alternative build command to use when `haskell-cabal-build' is called with a negative prefix argument. The `%s' placeholder is replaced by the cabal package top folder." :group 'haskell-compile :type 'string) (defcustom haskell-compile-command "ghc -Wall -ferror-spans -fforce-recomp -c %s" "Default build command to use for `haskell-cabal-build' when no cabal file is detected. The `%s' placeholder is replaced by the current buffer's filename." :group 'haskell-compile :type 'string) (defcustom haskell-compile-ghc-filter-linker-messages t "Filter out unremarkable \"Loading package...\" linker messages during compilation." :group 'haskell-compile :type 'boolean) (defconst haskell-compilation-error-regexp-alist `((,(concat "^\\(?1:[^ \t\r\n]+?\\):" "\\(?:" "\\(?2:[0-9]+\\):\\(?4:[0-9]+\\)\\(?:-\\(?5:[0-9]+\\)\\)?" ;; "121:1" & "12:3-5" "\\|" "(\\(?2:[0-9]+\\),\\(?4:[0-9]+\\))-(\\(?3:[0-9]+\\),\\(?5:[0-9]+\\))" ;; "(289,5)-(291,36)" "\\)" ":\\(?6: Warning:\\)?") 1 (2 . 3) (4 . 5) (6 . nil)) ;; error/warning locus ;; multiple declarations ("^ \\(?:Declared at:\\| \\) \\(?1:[^ \t\r\n]+\\):\\(?2:[0-9]+\\):\\(?4:[0-9]+\\)$" 1 2 4 0) ;; info locus ;; this is the weakest pattern as it's subject to line wrapping et al. (" at \\(?1:[^ \t\r\n]+\\):\\(?2:[0-9]+\\):\\(?4:[0-9]+\\)\\(?:-\\(?5:[0-9]+\\)\\)?[)]?$" 1 2 (4 . 5) 0)) ;; info locus "Regexps used for matching GHC compile messages. See `compilation-error-regexp-alist' for semantics.") (defvar haskell-compilation-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map compilation-mode-map)) "Keymap for `haskell-compilation-mode' buffers. This is a child of `compilation-mode-map'.") (defun haskell-compilation-filter-hook () "Local `compilation-filter-hook' for `haskell-compilation-mode'." (when haskell-compile-ghc-filter-linker-messages (delete-matching-lines "^Loading package [^ \t\r\n]+ [.]+ linking [.]+ done\\.$" (if (boundp 'compilation-filter-start) ;; available since Emacs 24.2 (save-excursion (goto-char compilation-filter-start) (line-beginning-position)) (point-min)) (point)))) (define-compilation-mode haskell-compilation-mode "HsCompilation" "Haskell/GHC specific `compilation-mode' derivative. This mode provides support for GHC 7.[46]'s compile messages. Specifically, also the `-ferror-spans` source location format is supported, as well as info-locations within compile messages pointing to additional source locations. See Info node `(haskell-mode)compilation' for more details." (set (make-local-variable 'compilation-error-regexp-alist) haskell-compilation-error-regexp-alist) (add-hook 'compilation-filter-hook 'haskell-compilation-filter-hook nil t) ) ;;;###autoload (defun haskell-compile (&optional edit-command) "Compile the Haskell program including the current buffer. Tries to locate the next cabal description in current or parent folders via `haskell-cabal-find-dir' and if found, invoke `haskell-compile-cabal-build-command' from the cabal package root folder. If no cabal package could be detected, `haskell-compile-command' is used instead. If prefix argument EDIT-COMMAND is non-nil (and not a negative prefix `-'), `haskell-compile' prompts for custom compile command. If EDIT-COMMAND contains the negative prefix argument `-', `haskell-compile' calls the alternative command defined in `haskell-compile-cabal-build-alt-command' if a cabal package was detected. `haskell-compile' uses `haskell-compilation-mode' which is derived from `compilation-mode'. See Info node `(haskell-mode)compilation' for more details." (interactive "P") (save-some-buffers (not compilation-ask-about-save) (if (boundp 'compilation-save-buffers-predicate) ;; since Emacs 24.1(?) compilation-save-buffers-predicate)) (let* ((cabdir (haskell-cabal-find-dir)) (command1 (if (eq edit-command '-) haskell-compile-cabal-build-alt-command haskell-compile-cabal-build-command)) (srcname (buffer-file-name)) (command (if cabdir (format command1 cabdir) (if (and srcname (derived-mode-p 'haskell-mode)) (format haskell-compile-command srcname) command1)))) (when (and edit-command (not (eq edit-command '-))) (setq command (compilation-read-command command))) (compilation-start command 'haskell-compilation-mode))) (provide 'haskell-compile) ;;; haskell-compile.el ends here haskell-mode-13.14.2/haskell-complete-module.el000066400000000000000000000114641253441665600213070ustar00rootroot00000000000000;;; haskell-complete-module.el --- A fast way to complete Haskell module names ;; Copyright (c) 2014 Chris Done. All rights reserved. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: (require 'cl-lib) (defcustom haskell-complete-module-preferred '() "Override ordering of module results by specifying preferred modules." :group 'haskell :type '(repeat string)) (defcustom haskell-complete-module-max-display 10 "Maximum items to display in minibuffer." :group 'haskell :type 'number) (defun haskell-complete-module-read (prompt candidates) "Interactively auto-complete from a list of candidates." (let ((continue t) (stack (list)) (pattern "") (result nil)) (delete-dups candidates) (setq candidates (sort candidates (lambda (a b) (let ((a-mem (member a haskell-complete-module-preferred)) (b-mem (member b haskell-complete-module-preferred))) (cond ((and a-mem (not b-mem)) t) ((and b-mem (not a-mem)) nil) (t (string< a b))))))) (while (not result) (let ((key (key-description (vector (read-key (concat (propertize prompt 'face 'minibuffer-prompt) (propertize pattern 'face 'font-lock-type-face) "{" (mapconcat #'identity (let* ((i 0)) (cl-loop for candidate in candidates while (<= i haskell-complete-module-max-display) do (cl-incf i) collect (cond ((> i haskell-complete-module-max-display) "...") ((= i 1) (propertize candidate 'face 'ido-first-match-face)) (t candidate)))) " | ") "}")))))) (cond ((string= key "C-g") (keyboard-quit)) ((string= key "DEL") (unless (null stack) (setq candidates (pop stack))) (unless (string= "" pattern) (setq pattern (substring pattern 0 -1)))) ((string= key "RET") (setq result (or (car candidates) pattern))) ((string= key "") (setq candidates (append (last candidates) (butlast candidates)))) ((string= key "") (setq candidates (append (cdr candidates) (list (car candidates))))) (t (when (string-match "[A-Za-z0-9_'.]+" key) (push candidates stack) (setq pattern (concat pattern key)) (setq candidates (haskell-complete-module pattern candidates))))))) result)) (defun haskell-complete-module (pattern candidates) "Filter the CANDIDATES using PATTERN." (let ((case-fold-search t)) (cl-loop for candidate in candidates when (haskell-complete-module-match pattern candidate) collect candidate))) (defun haskell-complete-module-match (pattern text) "Match PATTERN against TEXT." (string-match (haskell-complete-module-regexp pattern) text)) (defun haskell-complete-module-regexp (pattern) "Make a regular expression for the given module pattern. Example: \"c.m.s\" -> \"^c[^.]*\\.m[^.]*\\.s[^.]*\" " (let ((components (mapcar #'haskell-complete-module-component (split-string pattern "\\." t)))) (concat "^" (mapconcat #'identity components "\\.")))) (defun haskell-complete-module-component (component) "Make a regular expression for the given component. Example: \"co\" -> \"c[^.]*o[^.]*\" " (replace-regexp-in-string "\\(.\\)" "\\1[^.]*" component)) (provide 'haskell-complete-module) haskell-mode-13.14.2/haskell-customize.el000066400000000000000000000263721253441665600202420ustar00rootroot00000000000000;;; haskell-customize.el --- Customization settings ;; Copyright (c) 2014 Chris Done. All rights reserved. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: (require 'cl-lib) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Customization variables (defgroup haskell nil "Major mode for editing Haskell programs." :link '(custom-manual "(haskell-mode)") :group 'languages :prefix "haskell-") (defvar haskell-mode-pkg-base-dir (file-name-directory load-file-name) "Package base directory of installed `haskell-mode'. Used for locating additional package data files.") (defcustom haskell-completing-read-function 'ido-completing-read "Default function to use for completion." :group 'haskell :type '(choice (function-item :tag "ido" :value ido-completing-read) (function-item :tag "helm" :value helm--completing-read-default) (function-item :tag "completing-read" :value completing-read) (function :tag "Custom function"))) (defcustom haskell-process-type 'auto "The inferior Haskell process type to use." :type '(choice (const auto) (const ghci) (const cabal-repl) (const cabal-ghci)) :group 'haskell-interactive) (defcustom haskell-process-wrapper-function #'identity "Wrap or transform haskell process commands using this function. Can be set to a custom function which takes a list of arguments and returns a possibly-modified list. The following example function arranges for all haskell process commands to be started in the current nix-shell environment: (lambda (argv) (append (list \"nix-shell\" \"-I\" \".\" \"--command\" ) (list (mapconcat 'identity argv \" \")))) See Info Node `(emacs)Directory Variables' for a way to set this option on a per-project basis." :group 'haskell-interactive :type '(choice (function-item :tag "None" :value identity) (function :tag "Custom function"))) (defcustom haskell-ask-also-kill-buffers t "Ask whether to kill all associated buffers when a session process is killed." :type 'boolean :group 'haskell-interactive) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Configuration (defcustom haskell-doc-prettify-types t "Replace some parts of types with Unicode characters like \"∷\" when showing type information about symbols." :group 'haskell-doc :type 'boolean :safe 'booleanp) (defvar haskell-process-end-hook nil "Hook for when the haskell process ends.") (defgroup haskell-interactive nil "Settings for REPL interaction via `haskell-interactive-mode'" :link '(custom-manual "(haskell-mode)haskell-interactive-mode") :group 'haskell) (defcustom haskell-process-path-ghci "ghci" "The path for starting ghci." :group 'haskell-interactive :type '(choice string (repeat string))) (defcustom haskell-process-path-cabal "cabal" "Path to the `cabal' executable." :group 'haskell-interactive :type '(choice string (repeat string))) (defcustom haskell-process-path-cabal-ghci "cabal-ghci" "The path for starting cabal-ghci." :group 'haskell-interactive :type '(choice string (repeat string))) (defcustom haskell-process-args-ghci '("-ferror-spans") "Any arguments for starting ghci." :group 'haskell-interactive :type '(repeat (string :tag "Argument"))) (defcustom haskell-process-args-cabal-repl '("--ghc-option=-ferror-spans") "Additional arguments to for `cabal repl' invocation. Note: The settings in `haskell-process-path-ghci' and `haskell-process-args-ghci' are not automatically reused as `cabal repl' currently invokes `ghc --interactive'. Use `--with-ghc=' if you want to use a different interactive GHC frontend; use `--ghc-option=' to pass additional flags to `ghc'." :group 'haskell-interactive :type '(repeat (string :tag "Argument"))) (defcustom haskell-process-do-cabal-format-string ":!cd %s && %s" "The way to run cabal comands. It takes two arguments -- the directory and the command. See `haskell-process-do-cabal' for more details." :group 'haskell-interactive :type 'string) (defcustom haskell-process-log nil "Enable debug logging to \"*haskell-process-log*\" buffer." :type 'boolean :group 'haskell-interactive) (defcustom haskell-process-show-debug-tips t "Show debugging tips when starting the process." :type 'boolean :group 'haskell-interactive) (defcustom haskell-notify-p nil "Notify using notifications.el (if loaded)?" :type 'boolean :group 'haskell-interactive) (defcustom haskell-process-suggest-no-warn-orphans t "Suggest adding -fno-warn-orphans pragma to file when getting orphan warnings." :type 'boolean :group 'haskell-interactive) (defcustom haskell-process-suggest-hoogle-imports nil "Suggest to add import statements using Hoogle as a backend." :type 'boolean :group 'haskell-interactive) (defcustom haskell-process-suggest-hayoo-imports nil "Suggest to add import statements using Hayoo as a backend." :type 'boolean :group 'haskell-interactive) (defcustom haskell-process-hayoo-query-url "http://hayoo.fh-wedel.de/json/?query=%s" "Query url for json hayoo results." :type 'string :group 'haskell-interactive) (defcustom haskell-process-suggest-haskell-docs-imports nil "Suggest to add import statements using haskell-docs as a backend." :type 'boolean :group 'haskell-interactive) (defcustom haskell-process-suggest-add-package t "Suggest to add packages to your .cabal file when Cabal says it is a member of the hidden package, blah blah." :type 'boolean :group 'haskell-interactive) (defcustom haskell-process-suggest-language-pragmas t "Suggest adding LANGUAGE pragmas recommended by GHC." :type 'boolean :group 'haskell-interactive) (defcustom haskell-process-suggest-remove-import-lines nil "Suggest removing import lines as warned by GHC." :type 'boolean :group 'haskell-interactive) (defcustom haskell-process-suggest-overloaded-strings t "Suggest adding OverloadedStrings pragma to file when getting type mismatches with [Char]." :type 'boolean :group 'haskell-interactive) (defcustom haskell-process-check-cabal-config-on-load t "Check changes cabal config on loading Haskell files and restart the GHCi process if changed.." :type 'boolean :group 'haskell-interactive) (defcustom haskell-process-prompt-restart-on-cabal-change t "Ask whether to restart the GHCi process when the Cabal file has changed?" :type 'boolean :group 'haskell-interactive) (defcustom haskell-process-auto-import-loaded-modules nil "Auto import the modules reported by GHC to have been loaded?" :type 'boolean :group 'haskell-interactive) (defcustom haskell-process-reload-with-fbytecode nil "When using -fobject-code, auto reload with -fbyte-code (and then restore the -fobject-code) so that all module info and imports become available?" :type 'boolean :group 'haskell-interactive) (defcustom haskell-process-use-presentation-mode nil "Use presentation mode to show things like type info instead of printing to the message area." :type 'boolean :group 'haskell-interactive) (defcustom haskell-process-suggest-restart t "Suggest restarting the process when it has died" :type 'boolean :group 'haskell-interactive) (defcustom haskell-interactive-mode-scroll-to-bottom nil "Scroll to bottom in the REPL always." :type 'boolean :group 'haskell-interactive) (defcustom haskell-interactive-popup-errors t "Popup errors in a separate buffer." :type 'boolean :group 'haskell-interactive) (defcustom haskell-interactive-mode-collapse nil "Collapse printed results." :type 'boolean :group 'haskell-interactive) (defcustom haskell-interactive-types-for-show-ambiguous t "Show types when there's no Show instance or there's an ambiguous class constraint." :type 'boolean :group 'haskell-interactive) (defvar haskell-interactive-prompt "λ> " "The prompt to use.") (defcustom haskell-interactive-mode-eval-mode nil "Use the given mode's font-locking to render some text." :type '(choice function (const :tag "None" nil)) :group 'haskell-interactive) (defcustom haskell-interactive-mode-hide-multi-line-errors nil "Hide collapsible multi-line compile messages by default." :type 'boolean :group 'haskell-interactive) (defcustom haskell-interactive-mode-delete-superseded-errors t "Whether to delete compile messages superseded by recompile/reloads." :type 'boolean :group 'haskell-interactive) (defcustom haskell-interactive-mode-include-file-name t "Include the file name of the module being compiled when printing compilation messages." :type 'boolean :group 'haskell-interactive) (defcustom haskell-import-mapping '() "Support a mapping from module to import lines. E.g. '((\"Data.Map\" . \"import qualified Data.Map as M import Data.Map (Map) \")) This will import import qualified Data.Map as M import Data.Map (Map) when Data.Map is the candidate. " :type '(repeat (cons (string :tag "Module name") (string :tag "Import lines"))) :group 'haskell-interactive) (defcustom haskell-language-extensions '() "Language extensions in use. Should be in format: -XFoo, -XNoFoo etc." :group 'shm :type '(repeat 'string)) (defcustom haskell-ghc-supported-extensions (split-string (shell-command-to-string "ghc --supported-extensions")) "List of language extensions supported by the installed version of GHC." :group 'haskell :type '(repeat string)) (defcustom haskell-ghc-supported-options (split-string (shell-command-to-string "ghc --show-options")) "List of options supported by the installed version of GHC." :group 'haskell :type '(repeat string)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Accessor functions (defun haskell-process-type () "Return `haskell-process-type', or a guess if that variable is 'auto." (if (eq 'auto haskell-process-type) (if (locate-dominating-file default-directory (lambda (d) (or (file-directory-p (expand-file-name ".cabal-sandbox" d)) (cl-find-if (lambda (f) (string-match-p ".\\.cabal\\'" f)) (directory-files d))))) 'cabal-repl 'ghci) haskell-process-type)) ;;;###autoload (defun haskell-customize () "Browse the haskell customize sub-tree. This calls 'customize-browse' with haskell as argument and makes sure all haskell customize definitions have been loaded." (interactive) ;; make sure all modules with (defcustom ...)s are loaded (mapc 'require '(haskell-checkers haskell-compile haskell-doc haskell-font-lock haskell-indentation haskell-indent haskell-interactive-mode haskell-menu haskell-process inf-haskell)) (customize-browse 'haskell)) (provide 'haskell-customize) haskell-mode-13.14.2/haskell-debug.el000066400000000000000000000652431253441665600173060ustar00rootroot00000000000000;;; haskell-debug.el --- Debugging mode via GHCi ;; Copyright (c) 2014 Chris Done. All rights reserved. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: (require 'cl-lib) (require 'haskell-session) (require 'haskell-process) (require 'haskell-interactive-mode) (require 'haskell-font-lock) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Configuration (defgroup haskell-debug nil "Settings for debugging support." :link '(custom-manual "(haskell-mode)haskell-debug") :group 'haskell) (defface haskell-debug-warning-face '((t :inherit 'compilation-warning)) "Face for warnings." :group 'haskell-debug) (defface haskell-debug-trace-number-face '((t :weight bold :background "#f5f5f5")) "Face for numbers in backtrace." :group 'haskell-debug) (defface haskell-debug-newline-face '((t :weight bold :background "#f0f0f0")) "Face for newlines in trace steps." :group 'haskell-debug) (defface haskell-debug-keybinding-face '((t :inherit 'font-lock-type-face :weight bold)) "Face for keybindings." :group 'haskell-debug) (defface haskell-debug-heading-face '((t :inherit 'font-lock-keyword-face)) "Face for headings." :group 'haskell-debug) (defface haskell-debug-muted-face '((t :foreground "#999")) "Face for muteds." :group 'haskell-debug) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Mode (define-derived-mode haskell-debug-mode text-mode "Debug" "Major mode for debugging Haskell via GHCi.") (define-key haskell-debug-mode-map (kbd "g") 'haskell-debug/refresh) (define-key haskell-debug-mode-map (kbd "s") 'haskell-debug/step) (define-key haskell-debug-mode-map (kbd "t") 'haskell-debug/trace) (define-key haskell-debug-mode-map (kbd "d") 'haskell-debug/delete) (define-key haskell-debug-mode-map (kbd "b") 'haskell-debug/break-on-function) (define-key haskell-debug-mode-map (kbd "a") 'haskell-debug/abandon) (define-key haskell-debug-mode-map (kbd "c") 'haskell-debug/continue) (define-key haskell-debug-mode-map (kbd "p") 'haskell-debug/previous) (define-key haskell-debug-mode-map (kbd "n") 'haskell-debug/next) (define-key haskell-debug-mode-map (kbd "RET") 'haskell-debug/select) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Globals (defvar haskell-debug-history-cache nil "Cache of the tracing history.") (defvar haskell-debug-bindings-cache nil "Cache of the current step's bindings.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Macros (defmacro haskell-debug-with-breakpoints (&rest body) "Breakpoints need to exist to start stepping." `(if (haskell-debug-get-breakpoints) ,@body (error "No breakpoints to step into!"))) (defmacro haskell-debug-with-modules (&rest body) "Modules need to exist to do debugging stuff." `(if (haskell-debug-get-modules) ,@body (error "No modules loaded!"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Interactive functions (defun haskell-debug/select () "Select whatever is at point." (interactive) (cond ((get-text-property (point) 'break) (let ((break (get-text-property (point) 'break))) (haskell-debug-highlight (plist-get break :path) (plist-get break :span)))) ((get-text-property (point) 'module) (let ((break (get-text-property (point) 'module))) (haskell-debug-highlight (plist-get break :path)))))) (defun haskell-debug/abandon () "Abandon the current computation." (interactive) (haskell-debug-with-breakpoints (haskell-process-queue-sync-request (haskell-debug-process) ":abandon") (message "Computation abandoned.") (setq haskell-debug-history-cache nil) (setq haskell-debug-bindings-cache nil) (haskell-debug/refresh))) (defun haskell-debug/continue () "Continue the current computation." (interactive) (haskell-debug-with-breakpoints (haskell-process-queue-sync-request (haskell-debug-process) ":continue") (message "Computation continued.") (setq haskell-debug-history-cache nil) (setq haskell-debug-bindings-cache nil) (haskell-debug/refresh))) (defun haskell-debug/break-on-function () "Break on function IDENT." (interactive) (haskell-debug-with-modules (let ((ident (read-from-minibuffer "Function: " (haskell-ident-at-point)))) (haskell-process-queue-sync-request (haskell-debug-process) (concat ":break " ident)) (message "Breaking on function: %s" ident) (haskell-debug/refresh)))) (defun haskell-debug/start-step (expr) "Start stepping EXPR." (interactive (list (read-from-minibuffer "Expression to step through: "))) (haskell-debug/step expr)) (defun haskell-debug/breakpoint-numbers () "List breakpoint numbers." (interactive) (let ((breakpoints (mapcar (lambda (breakpoint) (number-to-string (plist-get breakpoint :number))) (haskell-debug-get-breakpoints)))) (if (null breakpoints) (message "No breakpoints.") (message "Breakpoint(s): %s" (mapconcat #'identity breakpoints ", "))))) (defun haskell-debug/next () "Go to next step to inspect bindings." (interactive) (haskell-debug-with-breakpoints (haskell-debug-navigate "forward"))) (defun haskell-debug/previous () "Go to previous step to inspect the bindings." (interactive) (haskell-debug-with-breakpoints (haskell-debug-navigate "back"))) (defun haskell-debug/refresh () "Refresh the debugger buffer." (interactive) (with-current-buffer (haskell-debug-buffer-name (haskell-debug-session)) (cd (haskell-session-current-dir (haskell-debug-session))) (let ((inhibit-read-only t) (p (point))) (erase-buffer) (insert (propertize (concat "Debugging " (haskell-session-name (haskell-debug-session)) "\n\n") 'face `((:weight bold)))) (let ((modules (haskell-debug-get-modules)) (breakpoints (haskell-debug-get-breakpoints)) (context (haskell-debug-get-context)) (history (haskell-debug-get-history))) (unless modules (insert (propertize "You have to load a module to start debugging." 'face 'haskell-debug-warning-face) "\n\n")) (haskell-debug-insert-bindings modules breakpoints context) (when modules (haskell-debug-insert-current-context context history) (haskell-debug-insert-breakpoints breakpoints)) (haskell-debug-insert-modules modules)) (insert "\n") (goto-char (min (point-max) p))))) (defun haskell-debug/delete () "Delete whatever's at the point." (interactive) (cond ((get-text-property (point) 'break) (let ((break (get-text-property (point) 'break))) (when (y-or-n-p (format "Delete breakpoint #%d?" (plist-get break :number))) (haskell-process-queue-sync-request (haskell-debug-process) (format ":delete %d" (plist-get break :number))) (haskell-debug/refresh)))))) (defun haskell-debug/trace () "Trace the expression." (interactive) (haskell-debug-with-modules (haskell-debug-with-breakpoints (let ((expr (read-from-minibuffer "Expression to trace: " (haskell-ident-at-point)))) (haskell-process-queue-sync-request (haskell-debug-process) (concat ":trace " expr)) (message "Tracing expression: %s" expr) (haskell-debug/refresh))))) (defun haskell-debug/step (&optional expr) "Step into the next function." (interactive) (haskell-debug-with-breakpoints (let* ((breakpoints (haskell-debug-get-breakpoints)) (context (haskell-debug-get-context)) (string (haskell-process-queue-sync-request (haskell-debug-process) (if expr (concat ":step " expr) ":step")))) (cond ((string= string "not stopped at a breakpoint\n") (if haskell-debug-bindings-cache (progn (setq haskell-debug-bindings-cache nil) (haskell-debug/refresh)) (call-interactively 'haskell-debug/start-step))) (t (let ((maybe-stopped-at (haskell-debug-parse-stopped-at string))) (cond (maybe-stopped-at (setq haskell-debug-bindings-cache maybe-stopped-at) (message "Computation paused.") (haskell-debug/refresh)) (t (if context (message "Computation finished.") (when (y-or-n-p "Computation completed without breaking. Reload the module and retry?") (message "Reloading and resetting breakpoints...") (haskell-interactive-mode-reset-error (haskell-debug-session)) (cl-loop for break in breakpoints do (haskell-process-queue-sync-request (haskell-debug-process) (concat ":load " (plist-get break :path)))) (cl-loop for break in breakpoints do (haskell-debug-break break)) (haskell-debug/step expr))))))))) (haskell-debug/refresh))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Internal functions (defun haskell-debug-session () "Get the Haskell session." (or (haskell-session-maybe) (error "No Haskell session associated with this debug buffer. Please just close the buffer and start again."))) (defun haskell-debug-process () "Get the Haskell session." (or (haskell-session-process (haskell-session-maybe)) (error "No Haskell session associated with this debug buffer. Please just close the buffer and start again."))) (defun haskell-debug-buffer-name (session) "The debug buffer name for the current session." (format "*debug:%s*" (haskell-session-name session))) (defun haskell-debug-get-breakpoints () "Get the list of breakpoints currently set." (let ((string (haskell-process-queue-sync-request (haskell-debug-process) ":show breaks"))) (if (string= string "No active breakpoints.\n") (list) (mapcar #'haskell-debug-parse-break-point (haskell-debug-split-string string))))) (defun haskell-debug-get-modules () "Get the list of modules currently set." (let ((string (haskell-process-queue-sync-request (haskell-debug-process) ":show modules"))) (if (string= string "") (list) (mapcar #'haskell-debug-parse-module (haskell-debug-split-string string))))) (defun haskell-debug-get-context () "Get the current context." (let ((string (haskell-process-queue-sync-request (haskell-debug-process) ":show context"))) (if (string= string "") nil (haskell-debug-parse-context string)))) (defun haskell-debug-get-history () "Get the step history." (let ((string (haskell-process-queue-sync-request (haskell-debug-process) ":history"))) (if (or (string= string "") (string= string "Not stopped at a breakpoint\n")) nil (if (string= string "Empty history. Perhaps you forgot to use :trace?\n") nil (let ((entries (mapcar #'haskell-debug-parse-history-entry (cl-remove-if (lambda (line) (or (string= "" line) (string= "..." line))) (haskell-debug-split-string string))))) (setq haskell-debug-history-cache entries) entries))))) (defun haskell-debug-insert-bindings (modules breakpoints context) "Insert a list of bindings." (if breakpoints (progn (haskell-debug-insert-binding "t" "trace an expression") (haskell-debug-insert-binding "s" "step into an expression") (haskell-debug-insert-binding "b" "breakpoint" t)) (progn (when modules (haskell-debug-insert-binding "b" "breakpoint")) (when breakpoints (haskell-debug-insert-binding "s" "step into an expression" t)))) (when breakpoints (haskell-debug-insert-binding "d" "delete breakpoint")) (when context (haskell-debug-insert-binding "a" "abandon context") (haskell-debug-insert-binding "c" "continue" t)) (when context (haskell-debug-insert-binding "p" "previous step") (haskell-debug-insert-binding "n" "next step" t)) (haskell-debug-insert-binding "g" "refresh" t) (insert "\n")) (defun haskell-debug-insert-current-context (context history) "Insert the current context." (haskell-debug-insert-header "Context") (if context (haskell-debug-insert-context context history) (haskell-debug-insert-debug-finished)) (insert "\n")) (defun haskell-debug-insert-breakpoints (breakpoints) "insert the list of breakpoints." (haskell-debug-insert-header "Breakpoints") (if (null breakpoints) (haskell-debug-insert-muted "No active breakpoints.") (cl-loop for break in breakpoints do (insert (propertize (format "%d" (plist-get break :number)) 'face `((:weight bold)) 'break break) (haskell-debug-muted " - ") (propertize (plist-get break :module) 'break break 'break break) (haskell-debug-muted (format " (%d:%d)" (plist-get (plist-get break :span) :start-line) (plist-get (plist-get break :span) :start-col))) "\n"))) (insert "\n")) (defun haskell-debug-insert-modules (modules) "Insert the list of modules." (haskell-debug-insert-header "Modules") (if (null modules) (haskell-debug-insert-muted "No loaded modules.") (progn (cl-loop for module in modules do (insert (propertize (plist-get module :module) 'module module 'face `((:weight bold))) (haskell-debug-muted " - ") (propertize (file-name-nondirectory (plist-get module :path)) 'module module)) do (insert "\n"))))) (defun haskell-debug-split-string (string) "Split GHCi's line-based output, stripping the trailing newline." (split-string string "\n" t)) (defun haskell-debug-parse-context (string) "Parse the context." (cond ((string-match "^--> \\(.+\\)\n \\(.+\\)" string) (let ((name (match-string 1 string)) (stopped (haskell-debug-parse-stopped-at (match-string 2 string)))) (list :name name :path (plist-get stopped :path) :span (plist-get stopped :span)))))) (defun haskell-debug-insert-binding (binding desc &optional end) "Insert a helpful keybinding." (insert (propertize binding 'face 'haskell-debug-keybinding-face) (haskell-debug-muted " - ") desc (if end "\n" (haskell-debug-muted ", ")))) (defun haskell-debug-insert-header (title) "Insert a header title." (insert (propertize title 'face 'haskell-debug-heading-face) "\n\n")) (defun haskell-debug-insert-context (context history) "Insert the context and history." (when context (insert (propertize (plist-get context :name) 'face `((:weight bold))) (haskell-debug-muted " - ") (file-name-nondirectory (plist-get context :path)) (haskell-debug-muted " (stopped)") "\n")) (when haskell-debug-bindings-cache (insert "\n") (let ((bindings haskell-debug-bindings-cache)) (insert (haskell-debug-get-span-string (plist-get bindings :path) (plist-get bindings :span))) (insert "\n\n") (cl-loop for binding in (plist-get bindings :types) do (insert (haskell-fontify-as-mode binding 'haskell-mode) "\n")))) (let ((history (or history (list (haskell-debug-make-fake-history context))))) (when history (insert "\n") (haskell-debug-insert-history history)))) (defun haskell-debug-insert-debug-finished () "Insert message that no debugging is happening, but if there is some old history, then display that." (if haskell-debug-history-cache (progn (haskell-debug-insert-muted "Finished debugging.") (insert "\n") (haskell-debug-insert-history haskell-debug-history-cache)) (haskell-debug-insert-muted "Not debugging right now."))) (defun haskell-debug-insert-muted (text) "Insert some muted text." (insert (haskell-debug-muted text) "\n")) (defun haskell-debug-muted (text) "Make some muted text." (propertize text 'face 'haskell-debug-muted-face)) (defun haskell-debug-parse-logged (string) "Parse the logged breakpoint." (cond ((string= "no more logged breakpoints\n" string) nil) ((string= "already at the beginning of the history\n" string) nil) (t (with-temp-buffer (insert string) (goto-char (point-min)) (list :path (progn (search-forward " at ") (buffer-substring-no-properties (point) (1- (search-forward ":")))) :span (haskell-debug-parse-span (buffer-substring-no-properties (point) (line-end-position))) :types (progn (forward-line) (haskell-debug-split-string (buffer-substring-no-properties (point) (point-max))))))))) (defun haskell-debug-parse-stopped-at (string) "Parse the location stopped at from the given string. For example: Stopped at /home/foo/project/src/x.hs:6:25-36 " (let ((index (string-match "Stopped at \\([^:]+\\):\\(.+\\)\n?" string))) (when index (list :path (match-string 1 string) :span (haskell-debug-parse-span (match-string 2 string)) :types (cdr (haskell-debug-split-string (substring string index))))))) (defun haskell-debug-get-span-string (path span) "Get the string from the PATH and the SPAN." (save-window-excursion (find-file path) (buffer-substring (save-excursion (goto-char (point-min)) (forward-line (1- (plist-get span :start-line))) (forward-char (1- (plist-get span :start-col))) (point)) (save-excursion (goto-char (point-min)) (forward-line (1- (plist-get span :end-line))) (forward-char (plist-get span :end-col)) (point))))) (defun haskell-debug-make-fake-history (context) "Make a fake history item." (list :index -1 :path (plist-get context :path) :span (plist-get context :span))) (defun haskell-debug-insert-history (history) "Insert tracing HISTORY." (let ((i (length history))) (cl-loop for span in history do (let ((string (haskell-debug-get-span-string (plist-get span :path) (plist-get span :span))) (index (plist-get span :index))) (insert (propertize (format "%4d" i) 'face 'haskell-debug-trace-number-face) " " (haskell-debug-preview-span (plist-get span :span) string t) "\n") (setq i (1- i)))))) (defun haskell-debug-parse-span (string) "Parse a source span from a string. Examples: (5,1)-(6,37) 6:25-36 5:20 People like to make other people's lives interesting by making variances in source span notation." (cond ((string-match "\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\)" string) (list :start-line (string-to-number (match-string 1 string)) :start-col (string-to-number (match-string 2 string)) :end-line (string-to-number (match-string 1 string)) :end-col (string-to-number (match-string 3 string)))) ((string-match "\\([0-9]+\\):\\([0-9]+\\)" string) (list :start-line (string-to-number (match-string 1 string)) :start-col (string-to-number (match-string 2 string)) :end-line (string-to-number (match-string 1 string)) :end-col (string-to-number (match-string 2 string)))) ((string-match "(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\))" string) (list :start-line (string-to-number (match-string 1 string)) :start-col (string-to-number (match-string 2 string)) :end-line (string-to-number (match-string 3 string)) :end-col (string-to-number (match-string 4 string)))) (t (error "Unable to parse source span from string: %s" string)))) (defun haskell-debug-preview-span (span string &optional collapsed) "Make a one-line preview of the given expression." (with-temp-buffer (haskell-mode) (insert string) (when (/= 0 (plist-get span :start-col)) (indent-rigidly (point-min) (point-max) 1)) (if (fboundp 'font-lock-ensure) (font-lock-ensure) (with-no-warnings (font-lock-fontify-buffer))) (when (/= 0 (plist-get span :start-col)) (indent-rigidly (point-min) (point-max) -1)) (goto-char (point-min)) (if collapsed (replace-regexp-in-string "\n[ ]*" (propertize " " 'face 'haskell-debug-newline-face) (buffer-substring (point-min) (point-max))) (buffer-string)))) (defun haskell-debug-start (session) "Start the debug mode." (setq buffer-read-only t) (haskell-session-assign session) (haskell-debug/refresh)) (defun haskell-debug () "Start the debugger for the current Haskell (GHCi) session." (interactive) (let ((session (haskell-debug-session))) (switch-to-buffer-other-window (haskell-debug-buffer-name session)) (unless (eq major-mode 'haskell-debug-mode) (haskell-debug-mode) (haskell-debug-start session)))) (defun haskell-debug-break (break) "Set BREAK breakpoint in module at line/col." (haskell-process-queue-without-filters (haskell-debug-process) (format ":break %s %s %d" (plist-get break :module) (plist-get (plist-get break :span) :start-line) (plist-get (plist-get break :span) :start-col)))) (defun haskell-debug-navigate (direction) "Navigate in DIRECTION \"back\" or \"forward\"." (let ((string (haskell-process-queue-sync-request (haskell-debug-process) (concat ":" direction)))) (let ((bindings (haskell-debug-parse-logged string))) (setq haskell-debug-bindings-cache bindings) (when (not bindings) (message "No more %s results!" direction))) (haskell-debug/refresh))) (defun haskell-debug-session-debugging-p (session) "Does the session have a debugging buffer open?" (not (not (get-buffer (haskell-debug-buffer-name session))))) (defun haskell-debug-highlight (path &optional span) "Highlight the file at span." (let ((p (make-overlay (line-beginning-position) (line-end-position)))) (overlay-put p 'face `((:background "#eee"))) (with-current-buffer (if span (save-window-excursion (find-file path) (current-buffer)) (find-file path) (current-buffer)) (let ((o (when span (make-overlay (save-excursion (goto-char (point-min)) (forward-line (1- (plist-get span :start-line))) (forward-char (1- (plist-get span :start-col))) (point)) (save-excursion (goto-char (point-min)) (forward-line (1- (plist-get span :end-line))) (forward-char (plist-get span :end-col)) (point)))))) (when o (overlay-put o 'face `((:background "#eee")))) (sit-for 0.5) (when o (delete-overlay o)) (delete-overlay p))))) (defun haskell-debug-parse-history-entry (string) "Parse a history entry." (if (string-match "^\\([-0-9]+\\)[ ]+:[ ]+\\([A-Za-z0-9_':]+\\)[ ]+(\\([^:]+\\):\\(.+?\\))$" string) (list :index (string-to-number (match-string 1 string)) :name (match-string 2 string) :path (match-string 3 string) :span (haskell-debug-parse-span (match-string 4 string))) (error "Unable to parse history entry: %s" string))) (defun haskell-debug-parse-module (string) "Parse a module and path. For example: X ( /home/foo/X.hs, interpreted ) " (if (string-match "^\\([^ ]+\\)[ ]+( \\([^ ]+?\\), [a-z]+ )$" string) (list :module (match-string 1 string) :path (match-string 2 string)) (error "Unable to parse module from string: %s" string))) (defun haskell-debug-parse-break-point (string) "Parse a breakpoint number, module and location from a string. For example: [13] Main /home/foo/src/x.hs:(5,1)-(6,37) " (if (string-match "^\\[\\([0-9]+\\)\\] \\([^ ]+\\) \\([^:]+\\):\\(.+\\)$" string) (list :number (string-to-number (match-string 1 string)) :module (match-string 2 string) :path (match-string 3 string) :span (haskell-debug-parse-span (match-string 4 string))) (error "Unable to parse breakpoint from string: %s" string))) (provide 'haskell-debug) ;;; haskell-debug.el ends here haskell-mode-13.14.2/haskell-decl-scan.el000066400000000000000000000626701253441665600200520ustar00rootroot00000000000000;;; haskell-decl-scan.el --- Declaration scanning module for Haskell Mode ;; Copyright (C) 2004, 2005, 2007, 2009 Free Software Foundation, Inc. ;; Copyright (C) 1997-1998 Graeme E Moss ;; Author: 1997-1998 Graeme E Moss ;; Maintainer: Stefan Monnier ;; Keywords: declarations menu files Haskell ;; URL: http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/CONTRIB/haskell-modes/emacs/haskell-decl-scan.el?rev=HEAD ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; Purpose: ;; ;; Top-level declarations are scanned and placed in a menu. Supports ;; full Latin1 Haskell 1.4 as well as literate scripts. ;; ;; ;; Installation: ;; ;; To turn declaration scanning on for all Haskell buffers under the ;; Haskell mode of Moss&Thorn, add this to .emacs: ;; ;; (add-hook 'haskell-mode-hook 'turn-on-haskell-decl-scan) ;; ;; Otherwise, call `turn-on-haskell-decl-scan'. ;; ;; ;; Customisation: ;; ;; M-x customize-group haskell-decl-scan ;; ;; ;; History: ;; ;; If you have any problems or suggestions, after consulting the list ;; below, email gem@cs.york.ac.uk quoting the version of the library ;; you are using, the version of Emacs you are using, and a small ;; example of the problem or suggestion. Note that this library ;; requires a reasonably recent version of Emacs. ;; ;; Uses `imenu' under Emacs. ;; ;; Version 1.2: ;; Added support for LaTeX-style literate scripts. ;; ;; Version 1.1: ;; Use own syntax table. Fixed bug for very small buffers. Use ;; markers instead of pointers (markers move with the text). ;; ;; Version 1.0: ;; Brought over from Haskell mode v1.1. ;; ;; ;; Present Limitations/Future Work (contributions are most welcome!): ;; ;; . Declarations requiring information extending beyond starting line ;; don't get scanned properly, eg. ;; > class Eq a => ;; > Test a ;; ;; . Comments placed in the midst of the first few lexemes of a ;; declaration will cause havoc, eg. ;; > infixWithComments :: Int -> Int -> Int ;; > x {-nastyComment-} `infixWithComments` y = x + y ;; but are not worth worrying about. ;; ;; . Would be nice to scan other top-level declarations such as ;; methods of a class, datatype field labels... any more? ;; ;; . Support for GreenCard? ;; ;; . Re-running (literate-)haskell-imenu should not cause the problems ;; that it does. The ability to turn off scanning would also be ;; useful. (Note that re-running (literate-)haskell-mode seems to ;; cause no problems.) ;; All functions/variables start with ;; `(turn-(on/off)-)haskell-decl-scan' or `haskell-ds-'. ;; The imenu support is based on code taken from `hugs-mode', ;; thanks go to Chris Van Humbeeck. ;; Version. ;;; Code: (require 'cl-lib) (require 'haskell-mode) (require 'syntax) (require 'imenu) (defgroup haskell-decl-scan nil "Haskell declaration scanning (`imenu' support)." :link '(custom-manual "(haskell-mode)haskell-decl-scan-mode") :group 'haskell :prefix "haskell-decl-scan-") (defcustom haskell-decl-scan-bindings-as-variables nil "Whether to put top-level value bindings into a \"Variables\" category." :group 'haskell-decl-scan :type 'boolean) (defcustom haskell-decl-scan-add-to-menubar t "Whether to add a \"Declarations\" menu entry to menu bar." :group 'haskell-decl-scan :type 'boolean) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; General declaration scanning functions. (defvar haskell-ds-start-keywords-re (concat "\\(\\<" "class\\|data\\|i\\(mport\\|n\\(fix\\(\\|[lr]\\)\\|stance\\)\\)\\|" "module\\|primitive\\|type\\|newtype" "\\)\\>") "Keywords that may start a declaration.") (defvar haskell-ds-syntax-table (let ((table (copy-syntax-table haskell-mode-syntax-table))) (modify-syntax-entry ?\' "w" table) (modify-syntax-entry ?_ "w" table) (modify-syntax-entry ?\\ "_" table) table) "Syntax table used for Haskell declaration scanning.") (defun haskell-ds-get-variable (prefix) "Return variable involved in value binding or type signature. Assumes point is looking at the regexp PREFIX followed by the start of a declaration (perhaps in the middle of a series of declarations concerning a single variable). Otherwise return nil. Point is not changed." ;; I think I can now handle all declarations bar those with comments ;; nested before the second lexeme. (save-excursion (with-syntax-table haskell-ds-syntax-table (if (looking-at prefix) (goto-char (match-end 0))) ;; Keyword. (if (looking-at haskell-ds-start-keywords-re) nil (or ;; Parenthesized symbolic variable. (and (looking-at "(\\(\\s_+\\))") (match-string-no-properties 1)) ;; General case. (if (looking-at (if (eq ?\( (char-after)) ;; Skip paranthesised expression. (progn (forward-sexp) ;; Repeating this code and avoiding moving point if ;; possible speeds things up. "\\(\\'\\)?\\s-*\\(\\s_+\\|`\\(\\sw+\\)`\\)") "\\(\\sw+\\)?\\s-*\\(\\s_+\\|`\\(\\sw+\\)`\\)")) (let ((match2 (match-string-no-properties 2))) ;; Weed out `::', `∷',`=' and `|' from potential infix ;; symbolic variable. (if (member match2 '("::" "∷" "=" "|")) ;; Variable identifier. (match-string-no-properties 1) (if (eq (aref match2 0) ?\`) ;; Infix variable identifier. (match-string-no-properties 3) ;; Infix symbolic variable. match2)))) ;; Variable identifier. (and (looking-at "\\sw+") (match-string-no-properties 0))))))) (defun haskell-ds-move-to-start-regexp (inc regexp) "Move to beginning of line that succeeds/precedes (INC = 1/-1) current line that starts with REGEXP and is not in `font-lock-comment-face'." ;; Making this defsubst instead of defun appears to have little or ;; no effect on efficiency. It is probably not called enough to do ;; so. (while (and (= (forward-line inc) 0) (or (not (looking-at regexp)) (eq (get-text-property (point) 'face) 'font-lock-comment-face))))) (defun haskell-ds-move-to-start-regexp-skipping-comments (inc regexp) "Like haskell-ds-move-to-start-regexp, but uses syntax-ppss to skip comments" (let (p) (cl-loop do (setq p (point)) (haskell-ds-move-to-start-regexp inc regexp) while (and (nth 4 (syntax-ppss)) (/= p (point)))))) (defvar literate-haskell-ds-line-prefix "> ?" "Regexp matching start of a line of Bird-style literate code. Current value is \"> \" as we assume top-level declarations start at column 3. Must not contain the special \"^\" regexp as we may not use the regexp at the start of a regexp string. Note this is only for `imenu' support.") (defvar haskell-ds-start-decl-re "\\(\\sw\\|(\\)" "The regexp that starts a Haskell declaration.") (defvar literate-haskell-ds-start-decl-re (concat literate-haskell-ds-line-prefix haskell-ds-start-decl-re) "The regexp that starts a Bird-style literate Haskell declaration.") (defun haskell-ds-move-to-decl (direction bird-literate fix) "General function for moving to the start of a declaration, either forwards or backwards from point, with normal or with Bird-style literate scripts. If DIRECTION is t, then forward, else backward. If BIRD-LITERATE is t, then treat as Bird-style literate scripts, else normal scripts. Returns point if point is left at the start of a declaration, and nil otherwise, ie. because point is at the beginning or end of the buffer and no declaration starts there. If FIX is t, then point does not move if already at the start of a declaration." ;; As `haskell-ds-get-variable' cannot separate an infix variable ;; identifier out of a value binding with non-alphanumeric first ;; argument, this function will treat such value bindings as ;; separate from the declarations surrounding it. (let ( ;; The variable typed or bound in the current series of ;; declarations. name ;; The variable typed or bound in the new declaration. newname ;; Hack to solve hard problem for Bird-style literate scripts ;; that start with a declaration. We are in the abyss if ;; point is before start of this declaration. abyss (line-prefix (if bird-literate literate-haskell-ds-line-prefix "")) ;; The regexp to match for the start of a declaration. (start-decl-re (if bird-literate literate-haskell-ds-start-decl-re haskell-ds-start-decl-re)) (increment (if direction 1 -1)) (bound (if direction (point-max) (point-min)))) ;; Change syntax table. (with-syntax-table haskell-ds-syntax-table ;; move to beginning of line that starts the "current ;; declaration" (dependent on DIRECTION and FIX), and then get ;; the variable typed or bound by this declaration, if any. (let ( ;; Where point was at call of function. (here (point)) ;; Where the declaration on this line (if any) starts. (start (progn (beginning-of-line) ;; Checking the face to ensure a declaration starts ;; here seems to be the only addition to make this ;; module support LaTeX-style literate scripts. (if (and (looking-at start-decl-re) (not (elt (syntax-ppss) 4))) (match-beginning 1))))) (if (and start ;; This complicated boolean determines whether we ;; should include the declaration that starts on the ;; current line as the "current declaration" or not. (or (and (or (and direction (not fix)) (and (not direction) fix)) (>= here start)) (and (or (and direction fix) (and (not direction) (not fix))) (> here start)))) ;; If so, we are already at start of the current line, so ;; do nothing. () ;; If point was before start of a declaration on the first ;; line of the buffer (possible for Bird-style literate ;; scripts) then we are in the abyss. (if (and start (bobp)) (setq abyss t) ;; Otherwise we move to the start of the first declaration ;; on a line preceding the current one, skipping comments (haskell-ds-move-to-start-regexp-skipping-comments -1 start-decl-re)))) ;; If we are in the abyss, position and return as appropriate. (if abyss (if (not direction) nil (re-search-forward (concat "\\=" line-prefix) nil t) (point)) ;; Get the variable typed or bound by this declaration, if any. (setq name (haskell-ds-get-variable line-prefix)) (if (not name) ;; If no such variable, stop at the start of this ;; declaration if moving backward, or move to the next ;; declaration if moving forward. (if direction (haskell-ds-move-to-start-regexp-skipping-comments 1 start-decl-re)) ;; If there is a variable, find the first ;; succeeding/preceding declaration that does not type or ;; bind it. Check for reaching start/end of buffer and ;; comments. (haskell-ds-move-to-start-regexp-skipping-comments increment start-decl-re) (while (and (/= (point) bound) (and (setq newname (haskell-ds-get-variable line-prefix)) (string= name newname))) (setq name newname) (haskell-ds-move-to-start-regexp-skipping-comments increment start-decl-re)) ;; If we are going backward, and have either reached a new ;; declaration or the beginning of a buffer that does not ;; start with a declaration, move forward to start of next ;; declaration (which must exist). Otherwise, we are done. (if (and (not direction) (or (and (looking-at start-decl-re) (not (string= name ;; Note we must not use ;; newname here as this may ;; not have been set if we ;; have reached the beginning ;; of the buffer. (haskell-ds-get-variable line-prefix)))) (and (not (looking-at start-decl-re)) (bobp)))) (haskell-ds-move-to-start-regexp-skipping-comments 1 start-decl-re))) ;; Store whether we are at the start of a declaration or not. ;; Used to calculate final result. (let ((at-start-decl (looking-at start-decl-re))) ;; If we are at the beginning of a line, move over ;; line-prefix, if present at point. (if (bolp) (re-search-forward (concat "\\=" line-prefix) (point-max) t)) ;; Return point if at the start of a declaration and nil ;; otherwise. (if at-start-decl (point) nil)))))) (defun haskell-ds-bird-p () (and (boundp 'haskell-literate) (eq haskell-literate 'bird))) (defun haskell-ds-backward-decl () "Move backward to the first character that starts a top-level declaration. A series of declarations concerning one variable is treated as one declaration by this function. So, if point is within a top-level declaration then move it to the start of that declaration. If point is already at the start of a top-level declaration, then move it to the start of the preceding declaration. Returns point if point is left at the start of a declaration, and nil otherwise, ie. because point is at the beginning of the buffer and no declaration starts there." (interactive) (haskell-ds-move-to-decl nil (haskell-ds-bird-p) nil)) (defun haskell-ds-forward-decl () "As `haskell-ds-backward-decl' but forward." (interactive) (haskell-ds-move-to-decl t (haskell-ds-bird-p) nil)) (defun haskell-ds-generic-find-next-decl (bird-literate) "Find the name, position and type of the declaration at or after point. Return ((NAME . (START-POSITION . NAME-POSITION)) . TYPE) if one exists and nil otherwise. The start-position is at the start of the declaration, and the name-position is at the start of the name of the declaration. The name is a string, the positions are buffer positions and the type is one of the symbols \"variable\", \"datatype\", \"class\", \"import\" and \"instance\"." (let ( ;; The name, type and name-position of the declaration to ;; return. name type name-pos ;; Buffer positions marking the start and end of the space ;; containing a declaration. start end) ;; Change to declaration scanning syntax. (with-syntax-table haskell-ds-syntax-table ;; Stop when we are at the end of the buffer or when a valid ;; declaration is grabbed. (while (not (or (eobp) name)) ;; Move forward to next declaration at or after point. (haskell-ds-move-to-decl t bird-literate t) ;; Start and end of search space is currently just the starting ;; line of the declaration. (setq start (point) end (line-end-position)) (cond ;; If the start of the top-level declaration does not begin ;; with a starting keyword, then (if legal) must be a type ;; signature or value binding, and the variable concerned is ;; grabbed. ((not (looking-at haskell-ds-start-keywords-re)) (setq name (haskell-ds-get-variable "")) (if name (progn (setq type 'variable) (re-search-forward (regexp-quote name) end t) (setq name-pos (match-beginning 0))))) ;; User-defined datatype declaration. ((re-search-forward "\\=\\(data\\|newtype\\|type\\)\\>" end t) (re-search-forward "=>" end t) (if (looking-at "[ \t]*\\(\\sw+\\)") (progn (setq name (match-string-no-properties 1)) (setq name-pos (match-beginning 1)) (setq type 'datatype)))) ;; Class declaration. ((re-search-forward "\\=class\\>" end t) (re-search-forward "=>" end t) (if (looking-at "[ \t]*\\(\\sw+\\)") (progn (setq name (match-string-no-properties 1)) (setq name-pos (match-beginning 1)) (setq type 'class)))) ;; Import declaration. ((looking-at "import[ \t]+\\(?:safe[\t ]+\\)?\\(?:qualified[ \t]+\\)?\\(?:\"[^\"]*\"[\t ]+\\)?\\(\\(?:\\sw\\|.\\)+\\)") (setq name (match-string-no-properties 1)) (setq name-pos (match-beginning 1)) (setq type 'import)) ;; Instance declaration. ((re-search-forward "\\=instance[ \t]+" end t) (re-search-forward "=>[ \t]+" end t) ;; The instance "title" starts just after the `instance' (and ;; any context) and finishes just before the _first_ `where' ;; if one exists. This solution is ugly, but I can't find a ;; nicer one---a simple regexp will pick up the last `where', ;; which may be rare but nevertheless... (setq name-pos (point)) (setq name (buffer-substring-no-properties (point) (progn ;; Look for a `where'. (if (re-search-forward "\\" end t) ;; Move back to just before the `where'. (progn (re-search-backward "\\s-where") (point)) ;; No `where' so move to last non-whitespace ;; before `end'. (progn (goto-char end) (skip-chars-backward " \t") (point)))))) ;; If we did not manage to extract a name, cancel this ;; declaration (eg. when line ends in "=> "). (if (string-match "^[ \t]*$" name) (setq name nil)) (setq type 'instance))) ;; Move past start of current declaration. (goto-char end)) ;; If we have a valid declaration then return it, otherwise return ;; nil. (if name (cons (cons name (cons (copy-marker start t) (copy-marker name-pos t))) type) nil)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Declaration scanning via `imenu'. ;;;###autoload (defun haskell-ds-create-imenu-index () "Function for finding `imenu' declarations in Haskell mode. Finds all declarations (classes, variables, imports, instances and datatypes) in a Haskell file for the `imenu' package." ;; Each list has elements of the form `(INDEX-NAME . INDEX-POSITION)'. ;; These lists are nested using `(INDEX-TITLE . INDEX-ALIST)'. (let* ((bird-literate (haskell-ds-bird-p)) (index-alist '()) (index-class-alist '()) ;; Classes (index-var-alist '()) ;; Variables (index-imp-alist '()) ;; Imports (index-inst-alist '()) ;; Instances (index-type-alist '()) ;; Datatypes ;; Variables for showing progress. (bufname (buffer-name)) (divisor-of-progress (max 1 (/ (buffer-size) 100))) ;; The result we wish to return. result) (goto-char (point-min)) ;; Loop forwards from the beginning of the buffer through the ;; starts of the top-level declarations. (while (< (point) (point-max)) (message "Scanning declarations in %s... (%3d%%)" bufname (/ (- (point) (point-min)) divisor-of-progress)) ;; Grab the next declaration. (setq result (haskell-ds-generic-find-next-decl bird-literate)) (if result ;; If valid, extract the components of the result. (let* ((name-posns (car result)) (name (car name-posns)) (posns (cdr name-posns)) (start-pos (car posns)) (type (cdr result)) ;; Place `(name . start-pos)' in the correct alist. (sym (cdr (assq type '((variable . index-var-alist) (datatype . index-type-alist) (class . index-class-alist) (import . index-imp-alist) (instance . index-inst-alist)))))) (set sym (cons (cons name start-pos) (symbol-value sym)))))) ;; Now sort all the lists, label them, and place them in one list. (message "Sorting declarations in %s..." bufname) (when index-type-alist (push (cons "Datatypes" (sort index-type-alist 'haskell-ds-imenu-label-cmp)) index-alist)) (when index-inst-alist (push (cons "Instances" (sort index-inst-alist 'haskell-ds-imenu-label-cmp)) index-alist)) (when index-imp-alist (push (cons "Imports" (sort index-imp-alist 'haskell-ds-imenu-label-cmp)) index-alist)) (when index-class-alist (push (cons "Classes" (sort index-class-alist 'haskell-ds-imenu-label-cmp)) index-alist)) (when index-var-alist (if haskell-decl-scan-bindings-as-variables (push (cons "Variables" (sort index-var-alist 'haskell-ds-imenu-label-cmp)) index-alist) (setq index-alist (append index-alist (sort index-var-alist 'haskell-ds-imenu-label-cmp))))) (message "Sorting declarations in %s...done" bufname) ;; Return the alist. index-alist)) (defun haskell-ds-imenu-label-cmp (el1 el2) "Predicate to compare labels in lists from `haskell-ds-create-imenu-index'." (string< (car el1) (car el2))) (defun haskell-ds-imenu () "Install `imenu' for Haskell scripts." (setq imenu-create-index-function 'haskell-ds-create-imenu-index) (when haskell-decl-scan-add-to-menubar (imenu-add-to-menubar "Declarations"))) ;; The main functions to turn on declaration scanning. ;;;###autoload (defun turn-on-haskell-decl-scan () "Unconditionally activate `haskell-decl-scan-mode'." (interactive) (haskell-decl-scan-mode)) ;;;###autoload (define-minor-mode haskell-decl-scan-mode "Toggle Haskell declaration scanning minor mode on or off. With a prefix argument ARG, enable minor mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. See also info node `(haskell-mode)haskell-decl-scan-mode' for more details about this minor mode. Top-level declarations are scanned and listed in the menu item \"Declarations\" (if enabled via option `haskell-decl-scan-add-to-menubar'). Selecting an item from this menu will take point to the start of the declaration. \\[beginning-of-defun] and \\[end-of-defun] move forward and backward to the start of a declaration. This may link with `haskell-doc-mode'. For non-literate and LaTeX-style literate scripts, we assume the common convention that top-level declarations start at the first column. For Bird-style literate scripts, we assume the common convention that top-level declarations start at the third column, ie. after \"> \". Anything in `font-lock-comment-face' is not considered for a declaration. Therefore, using Haskell font locking with comments coloured in `font-lock-comment-face' improves declaration scanning. Literate Haskell scripts are supported: If the value of `haskell-literate' (set automatically by `literate-haskell-mode') is `bird', a Bird-style literate script is assumed. If it is nil or `tex', a non-literate or LaTeX-style literate script is assumed, respectively. Invokes `haskell-decl-scan-mode-hook' on activation." :group 'haskell-decl-scan (kill-local-variable 'beginning-of-defun-function) (kill-local-variable 'end-of-defun-function) (kill-local-variable 'imenu-create-index-function) (unless haskell-decl-scan-mode ;; How can we cleanly remove the "Declarations" menu? (when haskell-decl-scan-add-to-menubar (local-set-key [menu-bar index] nil))) (when haskell-decl-scan-mode (set (make-local-variable 'beginning-of-defun-function) 'haskell-ds-backward-decl) (set (make-local-variable 'end-of-defun-function) 'haskell-ds-forward-decl) (haskell-ds-imenu))) ;; Provide ourselves: (provide 'haskell-decl-scan) ;;; haskell-decl-scan.el ends here haskell-mode-13.14.2/haskell-doc.el000066400000000000000000002457041253441665600167670ustar00rootroot00000000000000;;; haskell-doc.el --- show function types in echo area -*- coding: utf-8 -*- ;; Copyright (C) 2004, 2005, 2006, 2007, 2009 Free Software Foundation, Inc. ;; Copyright (C) 1997 Hans-Wolfgang Loidl ;; Author: Hans-Wolfgang Loidl ;; Temporary Maintainer and Hacker: Graeme E Moss ;; Keywords: extensions, minor mode, language mode, Haskell ;; Created: 1997-06-17 ;; URL: http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/CONTRIB/haskell-modes/emacs/haskell-doc.el?rev=HEAD ;; This file is not part of GNU Emacs. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; This program shows the type of the Haskell function under the cursor in the ;; minibuffer. It acts as a kind of "Emacs background process", by regularly ;; checking the word under the cursor and matching it against a list of ;; prelude, library, local and global functions. ;; This program was inspired by the `eldoc.el' package by Noah Friedman. ;; Installation: ;; Depending on the major mode you use for your Haskell programs add ;; one of the following to your .emacs: ;; ;; (add-hook 'haskell-mode-hook 'haskell-doc-mode) ;; Customisation: ;; You can control what exactly is shown by setting the following variables to ;; either t or nil: ;; `haskell-doc-show-global-types' (default: nil) ;; `haskell-doc-show-reserved' (default: t) ;; `haskell-doc-show-prelude' (default: t) ;; `haskell-doc-show-strategy' (default: t) ;; `haskell-doc-show-user-defined' (default: t) ;; If you want to define your own strings for some identifiers define an ;; alist of (ID . STRING) and set `haskell-doc-show-user-defined' to t. ;; E.g: ;; ;; (setq haskell-doc-show-user-defined t) ;; (setq haskell-doc-user-defined-ids ;; (list ;; '("main" . "just another pathetic main function") ;; '("foo" . "a very dummy name") ;; '("bar" . "another dummy name"))) ;; The following two variables are useful to make the type fit on one line: ;; If `haskell-doc-chop-off-context' is non-nil the context part of the type ;; of a local fct will be eliminated (default: t). ;; If `haskell-doc-chop-off-fctname' is non-nil the function name is not ;; shown together with the type (default: nil). ;; Internals: ;; `haskell-doc-mode' is implemented as a minor-mode. So, you can combine it ;; with any other mode. To enable it just type ;; M-x haskell-doc-mode ;; These are the names of the functions that can be called directly by the ;; user (with keybindings in `haskell-mode'): ;; `haskell-doc-mode' ... toggle haskell-doc-mode; with prefix turn it on ;; unconditionally if the prefix is greater 0 otherwise ;; turn it off ;; Key: CTRL-c CTRL-o (CTRL-u CTRL-c CTRL-o) ;; `haskell-doc-ask-mouse-for-type' ... show the type of the id under the mouse ;; Key: C-S-M-mouse-3 ;; `haskell-doc-show-reserved' ... toggle echoing of reserved id's types ;; `haskell-doc-show-prelude' ... toggle echoing of prelude id's types ;; `haskell-doc-show-strategy' ... toggle echoing of strategy id's types ;; `haskell-doc-show-user-defined' ... toggle echoing of user def id's types ;; `haskell-doc-check-active' ... check whether haskell-doc is active; ;; Key: CTRL-c ESC-/ ;; ToDo: ;; - Fix byte-compile problems in `haskell-doc-prelude-types' for getArgs etc ;; - Write a parser for .hi files. Read library interfaces via this parser. ;; - Indicate kind of object with colours ;; - Handle multi-line types ;; - Encode i-am-fct info in the alist of ids and types. ;; Bugs: ;; - Some prelude fcts aren't displayed properly. This might be due to a ;; name clash of Haskell and Elisp functions (e.g. length) which ;; confuses Emacs when reading `haskell-doc-prelude-types' ;;; Changelog: ;; $Log: haskell-doc.el,v $ ;; Revision 1.30 2009/02/02 21:00:33 monnier ;; (haskell-doc-imported-list): Don't add current buffer ;; to the imported file list if it is not (yet?) visiting a file. ;; ;; Revision 1.29 2007-12-12 04:04:19 monnier ;; (haskell-doc-in-code-p): New function. ;; (haskell-doc-show-type): Use it. ;; ;; Revision 1.28 2007/08/30 03:10:08 monnier ;; Comment/docs fixes. ;; ;; Revision 1.27 2007/07/30 17:36:50 monnier ;; (displayed-month): Remove declaration since it's not used here. ;; ;; Revision 1.26 2007/02/10 06:28:55 monnier ;; (haskell-doc-get-current-word): Remove. ;; Change all refs to it, to use haskell-ident-at-point instead. ;; ;; Revision 1.25 2007/02/09 21:53:42 monnier ;; (haskell-doc-get-current-word): Correctly distinguish ;; variable identifiers and infix identifiers. ;; (haskell-doc-rescan-files): Avoid switch-to-buffer. ;; (haskell-doc-imported-list): Operate on current buffer. ;; (haskell-doc-make-global-fct-index): Adjust call. ;; ;; Revision 1.24 2006/11/20 20:18:24 monnier ;; (haskell-doc-mode-print-current-symbol-info): Fix thinko. ;; ;; Revision 1.23 2006/10/20 03:12:31 monnier ;; Drop post-command-idle-hook in favor of run-with-idle-timer. ;; (haskell-doc-timer, haskell-doc-buffers): New vars. ;; (haskell-doc-mode): Use them. ;; (haskell-doc-check-active): Update the check. ;; (haskell-doc-mode-print-current-symbol-info): Remove the interactive spec. ;; Don't sit-for unless it's really needed. ;; ;; Revision 1.22 2006/09/20 18:42:35 monnier ;; Doc fix. ;; ;; Revision 1.21 2005/11/21 21:48:52 monnier ;; * haskell-doc.el (haskell-doc-extract-types): Get labelled data working. ;; (haskell-doc-prelude-types): Update via auto-generation. ;; ;; * haskell-doc.el (haskell-doc-extract-types): Get it partly working. ;; (haskell-doc-fetch-lib-urls): Don't use a literal if we apply ;; `nreverse' on it later on. ;; (haskell-doc-prelude-types): Update some parts by auto-generation. ;; (haskell-doc-grab, haskell-doc-string-nub-ws): Simplify. ;; ;; * haskell-doc.el (haskell-doc-maintainer, haskell-doc-varlist) ;; (haskell-doc-submit-bug-report, haskell-doc-ftp-site) ;; (haskell-doc-visit-home): Remove. ;; (haskell-doc-reserved-ids, haskell-doc-fetch-lib-urls) ;; (haskell-doc-extract-and-insert-types): New funs. ;; (haskell-doc-reserved-ids): Fix type of `map'. ;; ;; Revision 1.20 2005/11/21 21:27:57 monnier ;; (haskell-doc-extract-types): Get labelled data working. ;; (haskell-doc-prelude-types): Update via auto-generation. ;; ;; Revision 1.19 2005/11/21 20:44:13 monnier ;; (haskell-doc-extract-types): Get it partly working. ;; (haskell-doc-fetch-lib-urls): Don't use a literal if we apply ;; `nreverse' on it later on. ;; (haskell-doc-prelude-types): Update some parts by auto-generation. ;; (haskell-doc-grab, haskell-doc-string-nub-ws): Simplify. ;; ;; Revision 1.18 2005/11/21 18:02:15 monnier ;; (haskell-doc-maintainer, haskell-doc-varlist) ;; (haskell-doc-submit-bug-report, haskell-doc-ftp-site) ;; (haskell-doc-visit-home): Remove. ;; (haskell-doc-reserved-ids, haskell-doc-fetch-lib-urls) ;; (haskell-doc-extract-and-insert-types): New funs. ;; (haskell-doc-reserved-ids): Fix type of `map'. ;; ;; Revision 1.17 2005/11/20 23:55:09 monnier ;; Add coding cookie. ;; ;; Revision 1.16 2005/11/07 01:28:16 monnier ;; (haskell-doc-xemacs-p, haskell-doc-emacs-p) ;; (haskell-doc-message): Remove. ;; (haskell-doc-is-id-char-at): Remove. ;; (haskell-doc-get-current-word): Rewrite. ;; ;; Revision 1.15 2005/11/04 17:11:12 monnier ;; Add arch-tag. ;; ;; Revision 1.14 2005/08/24 11:36:32 monnier ;; (haskell-doc-message): Paren typo. ;; ;; Revision 1.13 2005/08/23 19:23:27 monnier ;; (haskell-doc-show-type): Assume that the availability ;; of display-message won't change at runtime. ;; ;; Revision 1.12 2005/07/18 21:04:14 monnier ;; (haskell-doc-message): Remove. ;; (haskell-doc-show-type): inline it. Do nothing for if there's no doc to show. ;; ;; Revision 1.11 2004/12/10 17:33:18 monnier ;; (haskell-doc-minor-mode-string): Make it dynamic. ;; (haskell-doc-install-keymap): Remove conflicting C-c C-o binding. ;; (haskell-doc-mode): Make a nil arg turn the mode ON. ;; (turn-on-haskell-doc-mode): Make it an alias for haskell-doc-mode. ;; (haskell-doc-mode): Don't touch haskell-doc-minor-mode-string. ;; (haskell-doc-show-global-types): Don't touch ;; haskell-doc-minor-mode-string. Call haskell-doc-make-global-fct-index. ;; (haskell-doc-check-active): Fix message. ;; (define-key-after): Don't define. ;; (haskell-doc-install-keymap): Check existence of define-key-after. ;; ;; Revision 1.10 2004/11/25 23:03:23 monnier ;; (haskell-doc-sym-doc): Make even the last char bold. ;; ;; Revision 1.9 2004/11/24 22:14:36 monnier ;; (haskell-doc-install-keymap): Don't blindly assume there's a Hugs menu. ;; ;; Revision 1.8 2004/11/22 10:45:35 simonmar ;; Fix type of getLine ;; ;; Revision 1.7 2004/10/14 22:27:47 monnier ;; (turn-off-haskell-doc-mode, haskell-doc-current-info): Don't autoload. ;; ;; Revision 1.6 2004/10/13 22:45:22 monnier ;; (haskell-doc): New group. ;; (haskell-doc-show-reserved, haskell-doc-show-prelude) ;; (haskell-doc-show-strategy, haskell-doc-show-user-defined) ;; (haskell-doc-chop-off-context, haskell-doc-chop-off-fctname): ;; Make them custom vars. ;; (haskell-doc-keymap): Declare and fill it right there. ;; (haskell-doc-mode): Simplify. ;; (haskell-doc-toggle-var): Make it into what it was supposed to be. ;; (haskell-doc-mode-print-current-symbol-info): Simplify. ;; (haskell-doc-current-info): New autoloaded function. ;; (haskell-doc-sym-doc): New fun extracted from haskell-doc-show-type. ;; (haskell-doc-show-type): Use it. ;; (haskell-doc-wrapped-type-p): Remove unused var `lim'. ;; (haskell-doc-forward-sexp-safe, haskell-doc-current-symbol): Remove. Unused. ;; (haskell-doc-visit-home): Don't require ange-ftp, it's autoloaded. ;; (haskell-doc-install-keymap): Simplify. ;; ;; Revision 1.5 2003/01/09 11:56:26 simonmar ;; Patches from Ville Skyttä , the XEmacs maintainer of ;; the haskell-mode: ;; ;; - Make the auto-mode-alist modifications autoload-only. ;; ;; Revision 1.4 2002/10/14 09:55:03 simonmar ;; Patch to update the Prelude/libraries function names and to remove ;; support for older versions of Haskell. ;; ;; Submitted by: Anders Lau Olsen ;; ;; Revision 1.3 2002/04/30 09:34:37 rrt ;; Remove supporting Haskell 1.4 and 1.2 from the ToDo list. It's Far Too Late. ;; ;; Add (require 'imenu). Thanks to N. Y. Kwok. ;; ;; Revision 1.2 2002/04/23 14:45:10 simonmar ;; Tweaks to the doc strings and support for customization, from ;; Ville Skyttä . ;; ;; Revision 1.1 2001/07/19 16:17:36 rrt ;; Add the current version of the Moss/Thorn/Marlow Emacs mode, along with its ;; web pages and sample files. This is now the preferred mode, and the ;; haskell.org pages are being changed to reflect that. Also includes the new ;; GHCi mode from Chris Webb. ;; ;; Revision 1.6 1998/12/10 16:27:25 hwloidl ;; Minor changes ("Doc" as modeline string, mouse-3 moved to C-S-M-mouse-3) ;; ;; Revision 1.5 1998/09/24 14:25:46 gem ;; Fixed minor compatibility bugs with Haskell mode of Moss&Thorn. ;; Disabled M-/ binding. ;; ;; Revision 1.4 1997/11/12 23:51:19 hwloidl ;; Fixed start-up problem under emacs-19.34. ;; Added support for wrapped (multi-line) types and 2 vars to control the ;; behaviour with long fct types ;; ;; Revision 1.3 1997/11/03 00:48:03 hwloidl ;; Major revision for first release. ;; Added alists for showing prelude fcts, haskell syntax, and strategies ;; Added mouse interface to show type under mouse ;; Fixed bug which causes demon to fall over ;; Works now with hugs-mode and haskell-mode under emacs 19.34,20 and xemacs 19.15 ;; ;;; Code: ;;@menu ;;* Constants and Variables:: ;;* Install as minor mode:: ;;* Menubar Support:: ;;* Haskell Doc Mode:: ;;* Switch it on or off:: ;;* Check:: ;;* Top level function:: ;;* Mouse interface:: ;;* Print fctsym:: ;;* Movement:: ;;* Bug Reports:: ;;* Visit home site:: ;;* Index:: ;;* Token:: ;;@end menu ;;@node top, Constants and Variables, (dir), (dir) ;;@top ;;@node Constants and Variables, Install as minor mode, top, top ;;@section Constants and Variables ;;@menu ;;* Emacs portability:: ;;* Maintenance stuff:: ;;* Mode Variable:: ;;* Variables:: ;;* Prelude types:: ;;* Test membership:: ;;@end menu ;;@node Emacs portability, Maintenance stuff, Constants and Variables, Constants and Variables ;;@subsection Emacs portability (eval-when-compile (require 'cl)) (require 'haskell-mode) (require 'haskell-process) (require 'haskell) (require 'inf-haskell) (require 'imenu) (require 'eldoc) (defgroup haskell-doc nil "Show Haskell function types in echo area." :group 'haskell :prefix "haskell-doc-") ;;@node Mode Variable, Variables, Maintenance stuff, Constants and Variables ;;@subsection Mode Variable (defvar haskell-doc-mode nil "*If non-nil, show the type of the function near point or a related comment. If the identifier near point is a Haskell keyword and the variable `haskell-doc-show-reserved' is non-nil show a one line summary of the syntax. If the identifier near point is a Prelude or one of the standard library functions and `haskell-doc-show-prelude' is non-nil show its type. If the identifier near point is local \(i.e. defined in this module\) check the `imenu' list of functions for the type. This obviously requires that your language mode uses `imenu'. If the identifier near point is global \(i.e. defined in an imported module\) and the variable `haskell-doc-show-global-types' is non-nil show the type of its function. If the identifier near point is a standard strategy or a function, type related related to strategies and `haskell-doc-show-strategy' is non-nil show the type of the function. Strategies are special to the parallel execution of Haskell. If you're not interested in that just turn it off. If the identifier near point is a user defined function that occurs as key in the alist `haskell-doc-user-defined-ids' and the variable `haskell-doc-show-user-defined' is non-nil show the type of the function. This variable is buffer-local.") (make-variable-buffer-local 'haskell-doc-mode) (defvar haskell-doc-mode-hook nil "Hook invoked when entering `haskell-doc-mode'.") (defvar haskell-doc-index nil "Variable holding an alist matching file names to fct-type alists. The function `haskell-doc-make-global-fct-index' rebuilds this variables \(similar to an `imenu' rescan\). This variable is buffer-local.") (make-variable-buffer-local 'haskell-doc-index) (defcustom haskell-doc-show-global-types nil "If non-nil, search for the types of global functions by loading the files. This variable is buffer-local." :group 'haskell-doc :type 'boolean) (make-variable-buffer-local 'haskell-doc-show-global-types) (defcustom haskell-doc-show-reserved t "If non-nil, show a documentation string for reserved ids. This variable is buffer-local." :group 'haskell-doc :type 'boolean) (make-variable-buffer-local 'haskell-doc-show-reserved) (defcustom haskell-doc-show-prelude t "If non-nil, show a documentation string for prelude functions. This variable is buffer-local." :group 'haskell-doc :type 'boolean) (make-variable-buffer-local 'haskell-doc-show-prelude) (defcustom haskell-doc-show-strategy t "If non-nil, show a documentation string for strategies. This variable is buffer-local." :group 'haskell-doc :type 'boolean) (make-variable-buffer-local 'haskell-doc-show-strategy) (defcustom haskell-doc-show-user-defined t "If non-nil, show a documentation string for user defined ids. This variable is buffer-local." :group 'haskell-doc :type 'boolean) (make-variable-buffer-local 'haskell-doc-show-user-defined) (defcustom haskell-doc-chop-off-context t "If non-nil eliminate the context part in a Haskell type." :group 'haskell-doc :type 'boolean) (defcustom haskell-doc-chop-off-fctname nil "If non-nil omit the function name and show only the type." :group 'haskell-doc :type 'boolean) (defcustom haskell-doc-use-inf-haskell nil "If non-nil use inf-haskell.el to get type and kind information." :group 'haskell-doc :type 'boolean) (defvar haskell-doc-search-distance 40 ; distance in characters "*How far to search when looking for the type declaration of fct under cursor.") ;;@node Variables, Prelude types, Mode Variable, Constants and Variables ;;@subsection Variables (defvar haskell-doc-idle-delay 0.50 "*Number of seconds of idle time to wait before printing. If user input arrives before this interval of time has elapsed after the last input, no documentation will be printed. If this variable is set to 0, no idle time is required.") (defvar haskell-doc-argument-case 'identity ; 'upcase "Case to display argument names of functions, as a symbol. This has two preferred values: `upcase' or `downcase'. Actually, any name of a function which takes a string as an argument and returns another string is acceptable.") (defvar haskell-doc-mode-message-commands nil "*Obarray of command names where it is appropriate to print in the echo area. This is not done for all commands since some print their own messages in the echo area, and these functions would instantly overwrite them. But `self-insert-command' as well as most motion commands are good candidates. It is probably best to manipulate this data structure with the commands `haskell-doc-add-command' and `haskell-doc-remove-command'.") ;;(cond ((null haskell-doc-mode-message-commands) ;; ;; If you increase the number of buckets, keep it a prime number. ;; (setq haskell-doc-mode-message-commands (make-vector 31 0)) ;; (let ((list '("self-insert-command" ;; "next-" "previous-" ;; "forward-" "backward-" ;; "beginning-of-" "end-of-" ;; "goto-" ;; "recenter" ;; "scroll-")) ;; (syms nil)) ;; (while list ;; (setq syms (all-completions (car list) obarray 'fboundp)) ;; (setq list (cdr list)) ;; (while syms ;; (set (intern (car syms) haskell-doc-mode-message-commands) t) ;; (setq syms (cdr syms))))))) ;; Bookkeeping; the car contains the last symbol read from the buffer. ;; The cdr contains the string last displayed in the echo area, so it can ;; be printed again if necessary without reconsing. (defvar haskell-doc-last-data '(nil . nil)) (defvar haskell-doc-minor-mode-string '(haskell-doc-show-global-types " DOC" " Doc") "*String to display in mode line when Haskell-Doc Mode is enabled.") ;;@node Prelude types, Test membership, Variables, Constants and Variables ;;@subsection Prelude types ;;@cindex haskell-doc-reserved-ids (defvar haskell-doc-reserved-ids '(("case" . "case exp of { alts [;] }") ("class" . "class [context =>] simpleclass [where { cbody [;] }]") ("data" . "data [context =>] simpletype = constrs [deriving]") ("default" . "default (type1 , ... , typen)") ("deriving" . "deriving (dclass | (dclass1, ... , dclassn))") ; used with data or newtype ("do" . "do { stmts [;] } stmts -> exp [; stmts] | pat <- exp ; stmts | let decllist ; stmts") ("else" . "if exp then exp else exp") ("if" . "if exp then exp else exp") ("import" . "import [qualified] modid [as modid] [impspec]") ("in" . "let decllist in exp") ("infix" . "infix [digit] ops") ("infixl" . "infixl [digit] ops") ("infixr" . "infixr [digit] ops") ("instance" . "instance [context =>] qtycls inst [where { valdefs [;] }]") ("let" . "let { decl; ...; decl [;] } in exp") ("module" . "module modid [exports] where body") ("newtype" . "newtype [context =>] simpletype = con atype [deriving]") ("of" . "case exp of { alts [;] }") ("then" . "if exp then exp else exp") ("type" . "type simpletype = type") ("where" . "exp where { decl; ...; decl [;] }") ; check that ; see also class, instance, module ("as" . "import [qualified] modid [as modid] [impspec]") ("qualified" . "import [qualified] modid [as modid] [impspec]") ("hiding" . "hiding ( import1 , ... , importn [ , ] )")) "An alist of reserved identifiers. Each element is of the form (ID . DOC) where both ID and DOC are strings. DOC should be a concise single-line string describing the construct in which the keyword is used.") (eval-and-compile (defalias 'haskell-doc-split-string (if (condition-case () (split-string "" nil t) (wrong-number-of-arguments nil)) 'split-string ;; copied from Emacs 22 (lambda (string &optional separators omit-nulls) (let ((keep-nulls (not (if separators omit-nulls t))) (rexp (or separators "[ \f\t\n\r\v]+")) (start 0) notfirst (list nil)) (while (and (string-match rexp string (if (and notfirst (= start (match-beginning 0)) (< start (length string))) (1+ start) start)) (< start (length string))) (setq notfirst t) (if (or keep-nulls (< start (match-beginning 0))) (setq list (cons (substring string start (match-beginning 0)) list))) (setq start (match-end 0))) (if (or keep-nulls (< start (length string))) (setq list (cons (substring string start) list))) (nreverse list)))))) ;;@cindex haskell-doc-prelude-types (defun haskell-doc-extract-types (url) (with-temp-buffer (insert-file-contents url) (goto-char (point-min)) (while (search-forward " " nil t) (replace-match " " t t)) ;; First, focus on the actual code, removing the surrounding HTML text. (goto-char (point-min)) (let ((last (point-min)) (modules nil)) (while (re-search-forward "^module +\\([[:alnum:]]+\\)" nil t) (let ((module (match-string 1))) (if (member module modules) ;; The library nodes of the HTML doc contain modules twice: ;; once at the top, with only type declarations, and once at ;; the bottom with an actual sample implementation which may ;; include declaration of non-exported values. ;; We're now at this second occurrence is the implementation ;; which should thus be ignored. nil (push module modules) (delete-region last (point)) (search-forward "") ;; Some of the blocks of code are split. (while (looking-at "\\(<[^<>]+>[ \t\n]*\\)*") (goto-char (match-end 0)) (search-forward "")) (setq last (point))))) (delete-region last (point-max)) ;; Then process the HTML encoding to get back to pure ASCII. (goto-char (point-min)) (while (search-forward "
" nil t) (replace-match "\n" t t)) ;; (goto-char (point-min)) ;; (while (re-search-forward "<[^<>]+>" nil t) (replace-match "" t t)) (goto-char (point-min)) (while (search-forward ">" nil t) (replace-match ">" t t)) (goto-char (point-min)) (while (search-forward "<" nil t) (replace-match "<" t t)) (goto-char (point-min)) (while (search-forward "&" nil t) (replace-match "&" t t)) (goto-char (point-min)) (if (re-search-forward "&[a-z]+;" nil t) (error "Unexpected charref %s" (match-string 0))) ;; Remove TABS. (goto-char (point-min)) (while (search-forward "\t" nil t) (replace-match " " t t)) ;; Finally, extract the actual data. (goto-char (point-min)) (let* ((elems nil) (space-re "[ \t\n]*\\(?:--.*\n[ \t\n]*\\)*") (comma-re (concat " *," space-re)) ;; A list of identifiers. We have to be careful to weed out ;; entries like "ratPrec = 7 :: Int". Also ignore entries ;; which start with a < since they're actually in the HTML text ;; part. And the list may be spread over several lines, cut ;; after a comma. (idlist-re (concat "\\([^< \t\n][^ \t\n]*" "\\(?:" comma-re "[^ \t\n]+\\)*\\)")) ;; A type. A few types are spread over 2 lines, ;; cut after the "=>", so we have to handle these as well. (type-re "\\(.*[^\n>]\\(?:>[ \t\n]+.*[^\n>]\\)*\\) *$") ;; A decl of a list of values, possibly indented. (val-decl-re (concat "^\\( +\\)?" idlist-re "[ \t\n]*::[ \t\n]*" type-re)) (re (concat ;; 3 possibilities: a class decl, a data decl, or val decl. ;; First, let's match a class decl. "^class \\(?:.*=>\\)? *\\(.*[^ \t\n]\\)[ \t\n]*where" ;; Or a value decl: "\\|" val-decl-re "\\|" ;; Or a data decl. We only handle single-arm ;; datatypes with labels. "^data +\\([[:alnum:]][[:alnum:] ]*[[:alnum:]]\\)" " *=.*{\\([^}]+\\)}" )) (re-class (concat "^[^ \t\n]\\|" re)) curclass) (while (re-search-forward (if curclass re-class re) nil t) (cond ;; A class decl. ((match-end 1) (setq curclass (match-string 1))) ;; A value decl. ((match-end 4) (let ((type (match-string 4)) (vars (match-string 3)) (indented (match-end 2))) (if (string-match "[ \t\n][ \t\n]+" type) (setq type (replace-match " " t t type))) (if (string-match " *\\(--.*\\)?\\'" type) (setq type (substring type 0 (match-beginning 0)))) (if indented (if curclass (if (string-match "\\`\\(.*[^ \t\n]\\) *=> *" type) (let ((classes (match-string 1 type))) (setq type (substring type (match-end 0))) (if (string-match "\\`(.*)\\'" classes) (setq classes (substring classes 1 -1))) (setq type (concat "(" curclass ", " classes ") => " type))) (setq type (concat curclass " => " type))) ;; It's actually not an error: just a type annotation on ;; some local variable. ;; (error "Indentation outside a class in %s: %s" ;; module vars) nil) (setq curclass nil)) (dolist (var (haskell-doc-split-string vars comma-re t)) (if (string-match "(.*)" var) (setq var (substring var 1 -1))) (push (cons var type) elems)))) ;; A datatype decl. ((match-end 5) (setq curclass nil) (let ((name (match-string 5))) (save-excursion (save-restriction (narrow-to-region (match-beginning 6) (match-end 6)) (goto-char (point-min)) (while (re-search-forward val-decl-re nil t) (let ((vars (match-string 2)) (type (match-string 3))) (if (string-match "[ \t\n][ \t\n]+" type) (setq type (replace-match " " t t type))) (if (string-match " *\\(--.*\\)?\\'" type) (setq type (substring type 0 (match-beginning 0)))) (if (string-match ",\\'" type) (setq type (substring type 0 -1))) (setq type (concat name " -> " type)) (dolist (var (haskell-doc-split-string vars comma-re t)) (if (string-match "(.*)" var) (setq var (substring var 1 -1))) (push (cons var type) elems)))))))) ;; The end of a class declaration. (t (setq curclass nil) (beginning-of-line)))) (cons (car (last modules)) elems))))) (defun haskell-doc-fetch-lib-urls (base-url) (with-temp-buffer (insert-file-contents base-url) (goto-char (point-min)) (search-forward "Part II: Libraries") (delete-region (point-min) (point)) (search-forward "") (delete-region (point) (point-max)) (goto-char (point-min)) (let ((libs (list "standard-prelude.html"))) (while (re-search-forward "" nil t) (push (match-string 1) libs)) (mapcar (lambda (s) (expand-file-name s (file-name-directory base-url))) (nreverse libs))))) (defun haskell-doc-extract-and-insert-types (url) "Fetch the types from the online doc and insert them at point. URL is the URL of the online doc." (interactive (if current-prefix-arg (read-file-name "URL: ") (list "http://www.haskell.org/onlinereport/"))) (let ((urls (haskell-doc-fetch-lib-urls url))) (dolist (url urls) (let ((data (haskell-doc-extract-types url))) (insert ";; " (pop data)) (indent-according-to-mode) (newline) (dolist (elem (sort data (lambda (x y) (string-lessp (car x) (car y))))) (prin1 elem (current-buffer)) (indent-according-to-mode) (newline)))))) (defvar haskell-doc-prelude-types ;; This list was auto generated by `haskell-doc-extract-and-insert-types'. '( ;; Prelude ("!!" . "[a] -> Int -> a") ("$" . "(a -> b) -> a -> b") ("$!" . "(a -> b) -> a -> b") ("&&" . "Bool -> Bool -> Bool") ("*" . "Num a => a -> a -> a") ("**" . "Floating a => a -> a -> a") ("+" . "Num a => a -> a -> a") ("++" . "[a] -> [a] -> [a]") ("-" . "Num a => a -> a -> a") ("." . "(b -> c) -> (a -> b) -> a -> c") ("/" . "Fractional a => a -> a -> a") ("/=" . "Eq a => a -> a -> Bool") ("<" . "Ord a => a -> a -> Bool") ("<=" . "Ord a => a -> a -> Bool") ("=<<" . "Monad m => (a -> m b) -> m a -> m b") ("==" . "Eq a => a -> a -> Bool") (">" . "Ord a => a -> a -> Bool") (">=" . "Ord a => a -> a -> Bool") (">>" . "Monad m => m a -> m b -> m b") (">>=" . "Monad m => m a -> (a -> m b) -> m b") ("^" . "(Num a, Integral b) => a -> b -> a") ("^^" . "(Fractional a, Integral b) => a -> b -> a") ("abs" . "Num a => a -> a") ("acos" . "Floating a => a -> a") ("acosh" . "Floating a => a -> a") ("all" . "(a -> Bool) -> [a] -> Bool") ("and" . "[Bool] -> Bool") ("any" . "(a -> Bool) -> [a] -> Bool") ("appendFile" . "FilePath -> String -> IO ()") ("asTypeOf" . "a -> a -> a") ("asin" . "Floating a => a -> a") ("asinh" . "Floating a => a -> a") ("atan" . "Floating a => a -> a") ("atan2" . "RealFloat a => a -> a -> a") ("atanh" . "Floating a => a -> a") ("break" . "(a -> Bool) -> [a] -> ([a],[a])") ("catch" . "IO a -> (IOError -> IO a) -> IO a") ("ceiling" . "(RealFrac a, Integral b) => a -> b") ("compare" . "Ord a => a -> a -> Ordering") ("concat" . "[[a]] -> [a]") ("concatMap" . "(a -> [b]) -> [a] -> [b]") ("const" . "a -> b -> a") ("cos" . "Floating a => a -> a") ("cosh" . "Floating a => a -> a") ("curry" . "((a, b) -> c) -> a -> b -> c") ("cycle" . "[a] -> [a]") ("decodeFloat" . "RealFloat a => a -> (Integer,Int)") ("div" . "Integral a => a -> a -> a") ("divMod" . "Integral a => a -> a -> (a,a)") ("drop" . "Int -> [a] -> [a]") ("dropWhile" . "(a -> Bool) -> [a] -> [a]") ("either" . "(a -> c) -> (b -> c) -> Either a b -> c") ("elem" . "(Eq a) => a -> [a] -> Bool") ("encodeFloat" . "RealFloat a => Integer -> Int -> a") ("enumFrom" . "Enum a => a -> [a]") ("enumFromThen" . "Enum a => a -> a -> [a]") ("enumFromThenTo" . "Enum a => a -> a -> a -> [a]") ("enumFromTo" . "Enum a => a -> a -> [a]") ("error" . "String -> a") ("even" . "(Integral a) => a -> Bool") ("exp" . "Floating a => a -> a") ("exponent" . "RealFloat a => a -> Int") ("fail" . "Monad m => String -> m a") ("filter" . "(a -> Bool) -> [a] -> [a]") ("flip" . "(a -> b -> c) -> b -> a -> c") ("floatDigits" . "RealFloat a => a -> Int") ("floatRadix" . "RealFloat a => a -> Integer") ("floatRange" . "RealFloat a => a -> (Int,Int)") ("floor" . "(RealFrac a, Integral b) => a -> b") ("fmap" . "Functor f => (a -> b) -> f a -> f b") ("foldl" . "(a -> b -> a) -> a -> [b] -> a") ("foldl1" . "(a -> a -> a) -> [a] -> a") ("foldr" . "(a -> b -> b) -> b -> [a] -> b") ("foldr1" . "(a -> a -> a) -> [a] -> a") ("fromEnum" . "Enum a => a -> Int") ("fromInteger" . "Num a => Integer -> a") ("fromIntegral" . "(Integral a, Num b) => a -> b") ("fromRational" . "Fractional a => Rational -> a") ("fst" . "(a,b) -> a") ("gcd" . "(Integral a) => a -> a -> a") ("getChar" . "IO Char") ("getContents" . "IO String") ("getLine" . "IO String") ("head" . "[a] -> a") ("id" . "a -> a") ("init" . "[a] -> [a]") ("interact" . "(String -> String) -> IO ()") ("ioError" . "IOError -> IO a") ("isDenormalized" . "RealFloat a => a -> Bool") ("isIEEE" . "RealFloat a => a -> Bool") ("isInfinite" . "RealFloat a => a -> Bool") ("isNaN" . "RealFloat a => a -> Bool") ("isNegativeZero" . "RealFloat a => a -> Bool") ("iterate" . "(a -> a) -> a -> [a]") ("last" . "[a] -> a") ("lcm" . "(Integral a) => a -> a -> a") ("length" . "[a] -> Int") ("lex" . "ReadS String") ("lines" . "String -> [String]") ("log" . "Floating a => a -> a") ("logBase" . "Floating a => a -> a -> a") ("lookup" . "(Eq a) => a -> [(a,b)] -> Maybe b") ("map" . "(a -> b) -> [a] -> [b]") ("mapM" . "Monad m => (a -> m b) -> [a] -> m [b]") ("mapM_" . "Monad m => (a -> m b) -> [a] -> m ()") ("max" . "Ord a => a -> a -> a") ("maxBound" . "Bounded a => a") ("maximum" . "(Ord a) => [a] -> a") ("maybe" . "b -> (a -> b) -> Maybe a -> b") ("min" . "Ord a => a -> a -> a") ("minBound" . "Bounded a => a") ("minimum" . "(Ord a) => [a] -> a") ("mod" . "Integral a => a -> a -> a") ("negate" . "Num a => a -> a") ("not" . "Bool -> Bool") ("notElem" . "(Eq a) => a -> [a] -> Bool") ("null" . "[a] -> Bool") ("numericEnumFrom" . "(Fractional a) => a -> [a]") ("numericEnumFromThen" . "(Fractional a) => a -> a -> [a]") ("numericEnumFromThenTo" . "(Fractional a, Ord a) => a -> a -> a -> [a]") ("numericEnumFromTo" . "(Fractional a, Ord a) => a -> a -> [a]") ("odd" . "(Integral a) => a -> Bool") ("or" . "[Bool] -> Bool") ("otherwise" . "Bool") ("pi" . "Floating a => a") ("pred" . "Enum a => a -> a") ("print" . "Show a => a -> IO ()") ("product" . "(Num a) => [a] -> a") ("properFraction" . "(RealFrac a, Integral b) => a -> (b,a)") ("putChar" . "Char -> IO ()") ("putStr" . "String -> IO ()") ("putStrLn" . "String -> IO ()") ("quot" . "Integral a => a -> a -> a") ("quotRem" . "Integral a => a -> a -> (a,a)") ("read" . "(Read a) => String -> a") ("readFile" . "FilePath -> IO String") ("readIO" . "Read a => String -> IO a") ("readList" . "Read a => ReadS [a]") ("readLn" . "Read a => IO a") ("readParen" . "Bool -> ReadS a -> ReadS a") ("reads" . "(Read a) => ReadS a") ("readsPrec" . "Read a => Int -> ReadS a") ("realToFrac" . "(Real a, Fractional b) => a -> b") ("recip" . "Fractional a => a -> a") ("rem" . "Integral a => a -> a -> a") ("repeat" . "a -> [a]") ("replicate" . "Int -> a -> [a]") ("return" . "Monad m => a -> m a") ("reverse" . "[a] -> [a]") ("round" . "(RealFrac a, Integral b) => a -> b") ("scaleFloat" . "RealFloat a => Int -> a -> a") ("scanl" . "(a -> b -> a) -> a -> [b] -> [a]") ("scanl1" . "(a -> a -> a) -> [a] -> [a]") ("scanr" . "(a -> b -> b) -> b -> [a] -> [b]") ("scanr1" . "(a -> a -> a) -> [a] -> [a]") ("seq" . "a -> b -> b") ("sequence" . "Monad m => [m a] -> m [a]") ("sequence_" . "Monad m => [m a] -> m ()") ("show" . "Show a => a -> String") ("showChar" . "Char -> ShowS") ("showList" . "Show a => [a] -> ShowS") ("showParen" . "Bool -> ShowS -> ShowS") ("showString" . "String -> ShowS") ("shows" . "(Show a) => a -> ShowS") ("showsPrec" . "Show a => Int -> a -> ShowS") ("significand" . "RealFloat a => a -> a") ("signum" . "Num a => a -> a") ("sin" . "Floating a => a -> a") ("sinh" . "Floating a => a -> a") ("snd" . "(a,b) -> b") ("span" . "(a -> Bool) -> [a] -> ([a],[a])") ("splitAt" . "Int -> [a] -> ([a],[a])") ("sqrt" . "Floating a => a -> a") ("subtract" . "(Num a) => a -> a -> a") ("succ" . "Enum a => a -> a") ("sum" . "(Num a) => [a] -> a") ("tail" . "[a] -> [a]") ("take" . "Int -> [a] -> [a]") ("takeWhile" . "(a -> Bool) -> [a] -> [a]") ("tan" . "Floating a => a -> a") ("tanh" . "Floating a => a -> a") ("toEnum" . "Enum a => Int -> a") ("toInteger" . "Integral a => a -> Integer") ("toRational" . "Real a => a -> Rational") ("truncate" . "(RealFrac a, Integral b) => a -> b") ("uncurry" . "(a -> b -> c) -> ((a, b) -> c)") ("undefined" . "a") ("unlines" . "[String] -> String") ("until" . "(a -> Bool) -> (a -> a) -> a -> a") ("unwords" . "[String] -> String") ("unzip" . "[(a,b)] -> ([a],[b])") ("unzip3" . "[(a,b,c)] -> ([a],[b],[c])") ("userError" . "String -> IOError") ("words" . "String -> [String]") ("writeFile" . "FilePath -> String -> IO ()") ("zip" . "[a] -> [b] -> [(a,b)]") ("zip3" . "[a] -> [b] -> [c] -> [(a,b,c)]") ("zipWith" . "(a->b->c) -> [a]->[b]->[c]") ("zipWith3" . "(a->b->c->d) -> [a]->[b]->[c]->[d]") ("||" . "Bool -> Bool -> Bool") ;; Ratio ("%" . "(Integral a) => a -> a -> Ratio a") ("approxRational" . "(RealFrac a) => a -> a -> Rational") ("denominator" . "(Integral a) => Ratio a -> a") ("numerator" . "(Integral a) => Ratio a -> a") ;; Complex ("cis" . "(RealFloat a) => a -> Complex a") ("conjugate" . "(RealFloat a) => Complex a -> Complex a") ("imagPart" . "(RealFloat a) => Complex a -> a") ("magnitude" . "(RealFloat a) => Complex a -> a") ("mkPolar" . "(RealFloat a) => a -> a -> Complex a") ("phase" . "(RealFloat a) => Complex a -> a") ("polar" . "(RealFloat a) => Complex a -> (a,a)") ("realPart" . "(RealFloat a) => Complex a -> a") ;; Numeric ("floatToDigits" . "(RealFloat a) => Integer -> a -> ([Int], Int)") ("fromRat" . "(RealFloat a) => Rational -> a") ("lexDigits" . "ReadS String") ("readDec" . "(Integral a) => ReadS a") ("readFloat" . "(RealFrac a) => ReadS a") ("readHex" . "(Integral a) => ReadS a") ("readInt" . "(Integral a) => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a") ("readOct" . "(Integral a) => ReadS a") ("readSigned" . "(Real a) => ReadS a -> ReadS a") ("showEFloat" . "(RealFloat a) => Maybe Int -> a -> ShowS") ("showFFloat" . "(RealFloat a) => Maybe Int -> a -> ShowS") ("showFloat" . "(RealFloat a) => a -> ShowS") ("showGFloat" . "(RealFloat a) => Maybe Int -> a -> ShowS") ("showHex" . "Integral a => a -> ShowS") ("showInt" . "Integral a => a -> ShowS") ("showIntAtBase" . "Integral a => a -> (Int -> Char) -> a -> ShowS") ("showOct" . "Integral a => a -> ShowS") ("showSigned" . "(Real a) => (a -> ShowS) -> Int -> a -> ShowS") ;; Ix ("inRange" . "Ix a => (a,a) -> a -> Bool") ("index" . "Ix a => (a,a) -> a -> Int") ("range" . "Ix a => (a,a) -> [a]") ("rangeSize" . "Ix a => (a,a) -> Int") ;; Array ("!" . "(Ix a) => Array a b -> a -> b") ("//" . "(Ix a) => Array a b -> [(a,b)] -> Array a b") ("accum" . "(Ix a) => (b -> c -> b) -> Array a b -> [(a,c)]") ("accumArray" . "(Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)]") ("array" . "(Ix a) => (a,a) -> [(a,b)] -> Array a b") ("assocs" . "(Ix a) => Array a b -> [(a,b)]") ("bounds" . "(Ix a) => Array a b -> (a,a)") ("elems" . "(Ix a) => Array a b -> [b]") ("indices" . "(Ix a) => Array a b -> [a]") ("ixmap" . "(Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c") ("listArray" . "(Ix a) => (a,a) -> [b] -> Array a b") ;; List ("\\\\" . "Eq a => [a] -> [a] -> [a]") ("delete" . "Eq a => a -> [a] -> [a]") ("deleteBy" . "(a -> a -> Bool) -> a -> [a] -> [a]") ("deleteFirstsBy" . "(a -> a -> Bool) -> [a] -> [a] -> [a]") ("elemIndex" . "Eq a => a -> [a] -> Maybe Int") ("elemIndices" . "Eq a => a -> [a] -> [Int]") ("find" . "(a -> Bool) -> [a] -> Maybe a") ("findIndex" . "(a -> Bool) -> [a] -> Maybe Int") ("findIndices" . "(a -> Bool) -> [a] -> [Int]") ("genericDrop" . "Integral a => a -> [b] -> [b]") ("genericIndex" . "Integral a => [b] -> a -> b") ("genericLength" . "Integral a => [b] -> a") ("genericReplicate" . "Integral a => a -> b -> [b]") ("genericSplitAt" . "Integral a => a -> [b] -> ([b],[b])") ("genericTake" . "Integral a => a -> [b] -> [b]") ("group" . "Eq a => [a] -> [[a]]") ("groupBy" . "(a -> a -> Bool) -> [a] -> [[a]]") ("inits" . "[a] -> [[a]]") ("insert" . "Ord a => a -> [a] -> [a]") ("insertBy" . "(a -> a -> Ordering) -> a -> [a] -> [a]") ("intersect" . "Eq a => [a] -> [a] -> [a]") ("intersectBy" . "(a -> a -> Bool) -> [a] -> [a] -> [a]") ("intersperse" . "a -> [a] -> [a]") ("isPrefixOf" . "Eq a => [a] -> [a] -> Bool") ("isSuffixOf" . "Eq a => [a] -> [a] -> Bool") ("mapAccumL" . "(a -> b -> (a, c)) -> a -> [b] -> (a, [c])") ("mapAccumR" . "(a -> b -> (a, c)) -> a -> [b] -> (a, [c])") ("maximumBy" . "(a -> a -> Ordering) -> [a] -> a") ("minimumBy" . "(a -> a -> Ordering) -> [a] -> a") ("nub" . "Eq a => [a] -> [a]") ("nubBy" . "(a -> a -> Bool) -> [a] -> [a]") ("partition" . "(a -> Bool) -> [a] -> ([a],[a])") ("sort" . "Ord a => [a] -> [a]") ("sortBy" . "(a -> a -> Ordering) -> [a] -> [a]") ("tails" . "[a] -> [[a]]") ("transpose" . "[[a]] -> [[a]]") ("unfoldr" . "(b -> Maybe (a,b)) -> b -> [a]") ("union" . "Eq a => [a] -> [a] -> [a]") ("unionBy" . "(a -> a -> Bool) -> [a] -> [a] -> [a]") ("unzip4" . "[(a,b,c,d)] -> ([a],[b],[c],[d])") ("unzip5" . "[(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])") ("unzip6" . "[(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])") ("unzip7" . "[(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])") ("zip4" . "[a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]") ("zip5" . "[a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]") ("zip6" . "[a] -> [b] -> [c] -> [d] -> [e] -> [f]") ("zip7" . "[a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]") ("zipWith4" . "(a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]") ("zipWith5" . "(a->b->c->d->e->f) ->") ("zipWith6" . "(a->b->c->d->e->f->g) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]") ("zipWith7" . "(a->b->c->d->e->f->g->h) -> [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]") ;; Maybe ("catMaybes" . "[Maybe a] -> [a]") ("fromJust" . "Maybe a -> a") ("fromMaybe" . "a -> Maybe a -> a") ("isJust" . "Maybe a -> Bool") ("isNothing" . "Maybe a -> Bool") ("listToMaybe" . "[a] -> Maybe a") ("mapMaybe" . "(a -> Maybe b) -> [a] -> [b]") ("maybeToList" . "Maybe a -> [a]") ;; Char ("chr" . "Int -> Char") ("digitToInt" . "Char -> Int") ("intToDigit" . "Int -> Char") ("isAlpha" . "Char -> Bool") ("isAlphaNum" . "Char -> Bool") ("isAscii" . "Char -> Bool") ("isControl" . "Char -> Bool") ("isDigit" . "Char -> Bool") ("isHexDigit" . "Char -> Bool") ("isLatin1" . "Char -> Bool") ("isLower" . "Char -> Bool") ("isOctDigit" . "Char -> Bool") ("isPrint" . "Char -> Bool") ("isSpace" . "Char -> Bool") ("isUpper" . "Char -> Bool") ("lexLitChar" . "ReadS String") ("ord" . "Char -> Int") ("readLitChar" . "ReadS Char") ("showLitChar" . "Char -> ShowS") ("toLower" . "Char -> Char") ("toUpper" . "Char -> Char") ;; Monad ("ap" . "Monad m => m (a -> b) -> m a -> m b") ("filterM" . "Monad m => (a -> m Bool) -> [a] -> m [a]") ("foldM" . "Monad m => (a -> b -> m a) -> a -> [b] -> m a") ("guard" . "MonadPlus m => Bool -> m ()") ("join" . "Monad m => m (m a) -> m a") ("liftM" . "Monad m => (a -> b) -> (m a -> m b)") ("liftM2" . "Monad m => (a -> b -> c) -> (m a -> m b -> m c)") ("liftM3" . "Monad m => (a -> b -> c -> d) -> (m a -> m b -> m c -> m d)") ("liftM4" . "Monad m => (a -> b -> c -> d -> e) -> (m a -> m b -> m c -> m d -> m e)") ("liftM5" . "Monad m => (a -> b -> c -> d -> e -> f) -> (m a -> m b -> m c -> m d -> m e -> m f)") ("mapAndUnzipM" . "Monad m => (a -> m (b,c)) -> [a] -> m ([b], [c])") ("mplus" . "MonadPlus m => m a -> m a -> m a") ("msum" . "MonadPlus m => [m a] -> m a") ("mzero" . "MonadPlus m => m a") ("unless" . "Monad m => Bool -> m () -> m ()") ("when" . "Monad m => Bool -> m () -> m ()") ("zipWithM" . "Monad m => (a -> b -> m c) -> [a] -> [b] -> m [c]") ("zipWithM_" . "Monad m => (a -> b -> m c) -> [a] -> [b] -> m ()") ;; IO ("bracket" . "IO a -> (a -> IO b) -> (a -> IO c) -> IO c") ("bracket_" . "IO a -> (a -> IO b) -> IO c -> IO c") ("hClose" . "Handle -> IO ()") ("hFileSize" . "Handle -> IO Integer") ("hFlush" . "Handle -> IO ()") ("hGetBuffering" . "Handle -> IO BufferMode") ("hGetChar" . "Handle -> IO Char") ("hGetContents" . "Handle -> IO String") ("hGetLine" . "Handle -> IO String") ("hGetPosn" . "Handle -> IO HandlePosn") ("hIsClosed" . "Handle -> IO Bool") ("hIsEOF" . "Handle -> IO Bool") ("hIsOpen" . "Handle -> IO Bool") ("hIsReadable" . "Handle -> IO Bool") ("hIsSeekable" . "Handle -> IO Bool") ("hIsWritable" . "Handle -> IO Bool") ("hLookAhead" . "Handle -> IO Char") ("hPrint" . "Show a => Handle -> a -> IO ()") ("hPutChar" . "Handle -> Char -> IO ()") ("hPutStr" . "Handle -> String -> IO ()") ("hPutStrLn" . "Handle -> String -> IO ()") ("hReady" . "Handle -> IO Bool") ("hSeek" . "Handle -> SeekMode -> Integer -> IO ()") ("hSetBuffering" . "Handle -> BufferMode -> IO ()") ("hSetPosn" . "HandlePosn -> IO ()") ("hWaitForInput" . "Handle -> Int -> IO Bool") ("ioeGetErrorString" . "IOError -> String") ("ioeGetFileName" . "IOError -> Maybe FilePath") ("ioeGetHandle" . "IOError -> Maybe Handle") ("isAlreadyExistsError" . "IOError -> Bool") ("isAlreadyInUseError" . "IOError -> Bool") ("isDoesNotExistError" . "IOError -> Bool") ("isEOF" . "IO Bool") ("isEOFError" . "IOError -> Bool") ("isFullError" . "IOError -> Bool") ("isIllegalOperation" . "IOError -> Bool") ("isPermissionError" . "IOError -> Bool") ("isUserError" . "IOError -> Bool") ("openFile" . "FilePath -> IOMode -> IO Handle") ("stderr" . "Handle") ("stdin" . "Handle") ("stdout" . "Handle") ("try" . "IO a -> IO (Either IOError a)") ;; Directory ("createDirectory" . "FilePath -> IO ()") ("doesDirectoryExist" . "FilePath -> IO Bool") ("doesFileExist" . "FilePath -> IO Bool") ("executable" . "Permissions -> Bool") ("getCurrentDirectory" . "IO FilePath") ("getDirectoryContents" . "FilePath -> IO [FilePath]") ("getModificationTime" . "FilePath -> IO ClockTime") ("getPermissions" . "FilePath -> IO Permissions") ("readable" . "Permissions -> Bool") ("removeDirectory" . "FilePath -> IO ()") ("removeFile" . "FilePath -> IO ()") ("renameDirectory" . "FilePath -> FilePath -> IO ()") ("renameFile" . "FilePath -> FilePath -> IO ()") ("searchable" . "Permissions -> Bool") ("setCurrentDirectory" . "FilePath -> IO ()") ("setPermissions" . "FilePath -> Permissions -> IO ()") ("writable" . "Permissions -> Bool") ;; System ("exitFailure" . "IO a") ("exitWith" . "ExitCode -> IO a") ("getArgs" . "IO [String]") ("getEnv" . "String -> IO String") ("getProgName" . "IO String") ("system" . "String -> IO ExitCode") ;; Time ("addToClockTime" . "TimeDiff -> ClockTime -> ClockTime") ("calendarTimeToString" . "CalendarTime -> String") ("ctDay" . "CalendarTime -> Int") ("ctHour" . "CalendarTime -> Int") ("ctIsDST" . "CalendarTime -> Bool") ("ctMin" . "CalendarTime -> Int") ("ctMonth" . "CalendarTime -> Month") ("ctPicosec" . "CalendarTime -> Integer") ("ctSec" . "CalendarTime -> Int") ("ctTZ" . "CalendarTime -> Int") ("ctTZName" . "CalendarTime -> String") ("ctWDay" . "CalendarTime -> Day") ("ctYDay" . "CalendarTime -> Int") ("ctYear" . "CalendarTime -> Int") ("diffClockTimes" . "ClockTime -> ClockTime -> TimeDiff") ("formatCalendarTime" . "TimeLocale -> String -> CalendarTime -> String") ("getClockTime" . "IO ClockTime") ("tdDay" . "TimeDiff -> Int") ("tdHour" . "TimeDiff -> Int") ("tdMin" . "TimeDiff -> Int") ("tdMonth" . "TimeDiff -> Int") ("tdPicosec" . "TimeDiff -> Integer") ("tdSec" . "TimeDiff -> Int") ("tdYear" . "TimeDiff -> Int") ("toCalendarTime" . "ClockTime -> IO CalendarTime") ("toClockTime" . "CalendarTime -> ClockTime") ("toUTCTime" . "ClockTime -> CalendarTime") ;; Locale ("amPm" . "TimeLocale -> (String, String)") ("dateFmt" . "TimeLocale -> String") ("dateTimeFmt" . "TimeLocale -> String") ("defaultTimeLocale" . "TimeLocale") ("months" . "TimeLocale -> [(String, String)]") ("time12Fmt" . "TimeLocale -> String") ("timeFmt" . "TimeLocale -> String") ("wDays" . "TimeLocale -> [(String, String)]") ;; CPUTime ("cpuTimePrecision" . "Integer") ("getCPUTime" . "IO Integer") ;; Random ("genRange" . "RandomGen g => g -> (Int, Int)") ("getStdGen" . "IO StdGen") ("getStdRandom" . "(StdGen -> (a, StdGen)) -> IO a") ("mkStdGen" . "Int -> StdGen") ("newStdGen" . "IO StdGen") ("next" . "RandomGen g => g -> (Int, g)") ("random" . "(Random a, RandomGen g) => g -> (a, g)") ("randomIO" . "Random a => IO a") ("randomR" . "(Random a, RandomGen g) => (a, a) -> g -> (a, g)") ("randomRIO" . "Random a => (a,a) -> IO a") ("randomRs" . "(Random a, RandomGen g) => (a, a) -> g -> [a]") ("randoms" . "(Random a, RandomGen g) => g -> [a]") ("setStdGen" . "StdGen -> IO ()") ("split" . "RandomGen g => g -> (g, g)") ) "Alist of prelude functions and their types.") ;;@cindex haskell-doc-strategy-ids (defvar haskell-doc-strategy-ids (list '("par" . "Done -> Done -> Done ; [infixr 0]") '("seq" . "Done -> Done -> Done ; [infixr 1]") '("using" . "a -> Strategy a -> a ; [infixl 0]") '("demanding" . "a -> Done -> a ; [infixl 0]") '("sparking" . "a -> Done -> a ; [infixl 0]") '(">||" . "Done -> Done -> Done ; [infixr 2]") '(">|" . "Done -> Done -> Done ; [infixr 3]") '("$||" . "(a -> b) -> Strategy a -> a -> b ; [infixl 6]") '("$|" . "(a -> b) -> Strategy a -> a -> b ; [infixl 6]") '(".|" . "(b -> c) -> Strategy b -> (a -> b) -> (a -> c) ; [infixl 9]") '(".||" . "(b -> c) -> Strategy b -> (a -> b) -> (a -> c) ; [infixl 9]") '("-|" . "(a -> b) -> Strategy b -> (b -> c) -> (a -> c) ; [infixl 9]") '("-||" . "(a -> b) -> Strategy b -> (b -> c) -> (a -> c) ; [infixl 9]") '("Done" . "type Done = ()") '("Strategy" . "type Strategy a = a -> Done") '("r0" . "Strategy a") '("rwhnf" . "Eval a => Strategy a") '("rnf" . "Strategy a") '("NFData" . "class Eval a => NFData a where rnf :: Strategy a") '("NFDataIntegral" ."class (NFData a, Integral a) => NFDataIntegral a") '("NFDataOrd" . "class (NFData a, Ord a) => NFDataOrd a") '("markStrat" . "Int -> Strategy a -> Strategy a") '("seqPair" . "Strategy a -> Strategy b -> Strategy (a,b)") '("parPair" . "Strategy a -> Strategy b -> Strategy (a,b)") '("seqTriple" . "Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c)") '("parTriple" . "Strategy a -> Strategy b -> Strategy c -> Strategy (a,b,c)") '("parList" . "Strategy a -> Strategy [a]") '("parListN" . "(Integral b) => b -> Strategy a -> Strategy [a]") '("parListNth" . "Int -> Strategy a -> Strategy [a]") '("parListChunk" . "Int -> Strategy a -> Strategy [a]") '("parMap" . "Strategy b -> (a -> b) -> [a] -> [b]") '("parFlatMap" . "Strategy [b] -> (a -> [b]) -> [a] -> [b]") '("parZipWith" . "Strategy c -> (a -> b -> c) -> [a] -> [b] -> [c]") '("seqList" . "Strategy a -> Strategy [a]") '("seqListN" . "(Integral a) => a -> Strategy b -> Strategy [b]") '("seqListNth" . "Int -> Strategy b -> Strategy [b]") '("parBuffer" . "Int -> Strategy a -> [a] -> [a]") '("seqArr" . "(Ix b) => Strategy a -> Strategy (Array b a)") '("parArr" . "(Ix b) => Strategy a -> Strategy (Array b a)") '("fstPairFstList" . "(NFData a) => Strategy [(a,b)]") '("force" . "(NFData a) => a -> a ") '("sforce" . "(NFData a) => a -> b -> b") ) "Alist of strategy functions and their types as defined in Strategies.lhs.") (defvar haskell-doc-user-defined-ids nil "Alist of functions and strings defined by the user.") ;;@node Test membership, , Prelude types, Constants and Variables ;;@subsection Test membership ;;@cindex haskell-doc-is-of (defsubst haskell-doc-is-of (fn types) "Check whether FN is one of the functions in the alist TYPES and return the type." (assoc fn types) ) ;;@node Install as minor mode, Menubar Support, Constants and Variables, top ;;@section Install as minor mode ;; Put this minor mode on the global minor-mode-alist. (or (assq 'haskell-doc-mode (default-value 'minor-mode-alist)) (setq-default minor-mode-alist (append (default-value 'minor-mode-alist) '((haskell-doc-mode haskell-doc-minor-mode-string))))) ;;@node Menubar Support, Haskell Doc Mode, Install as minor mode, top ;;@section Menubar Support ;; a dummy definition needed for XEmacs (I know, it's horrible :-( ;;@cindex haskell-doc-install-keymap (defvar haskell-doc-keymap (let ((map (make-sparse-keymap))) (define-key map [visit] '("Visit FTP home site" . haskell-doc-visit-home)) (define-key map [submit] '("Submit bug report" . haskell-doc-submit-bug-report)) (define-key map [dummy] '("---" . nil)) (define-key map [make-index] '("Make global fct index" . haskell-doc-make-global-fct-index)) (define-key map [global-types-on] '("Toggle display of global types" . haskell-doc-show-global-types)) (define-key map [strategy-on] '("Toggle display of strategy ids" . haskell-doc-show-strategy)) (define-key map [user-defined-on] '("Toggle display of user defined ids" . haskell-doc-show-user-defined)) (define-key map [prelude-on] '("Toggle display of prelude functions" . haskell-doc-show-prelude)) (define-key map [reserved-ids-on] '("Toggle display of reserved ids" . haskell-doc-show-reserved)) (define-key map [haskell-doc-on] '("Toggle haskell-doc mode" . haskell-doc-mode)) map)) (defun haskell-doc-install-keymap () "Install a menu for `haskell-doc-mode' as a submenu of \"Hugs\"." (interactive) ;; Add the menu to the hugs menu as last entry. (let ((hugsmap (lookup-key (current-local-map) [menu-bar Hugs]))) (if (not (or (featurep 'xemacs) ; XEmacs has problems here (not (keymapp hugsmap)) (lookup-key hugsmap [haskell-doc]))) (if (functionp 'define-key-after) (define-key-after hugsmap [haskell-doc] (cons "Haskell-doc" haskell-doc-keymap) [Haskell-doc mode])))) ;; Add shortcuts for these commands. (local-set-key "\C-c\e/" 'haskell-doc-check-active) ;; Conflicts with the binding of haskell-insert-otherwise. ;; (local-set-key "\C-c\C-o" 'haskell-doc-mode) (local-set-key [(control shift meta mouse-3)] 'haskell-doc-ask-mouse-for-type)) ;;@node Haskell Doc Mode, Switch it on or off, Menubar Support, top ;;@section Haskell Doc Mode ;;@cindex haskell-doc-mode (defvar haskell-doc-timer nil) (defvar haskell-doc-buffers nil) ;;;###autoload (defun haskell-doc-mode (&optional arg) "Enter `haskell-doc-mode' for showing fct types in the echo area. See variable docstring." (interactive (list (or current-prefix-arg 'toggle))) (setq haskell-doc-mode (cond ((eq arg 'toggle) (not haskell-doc-mode)) (arg (> (prefix-numeric-value arg) 0)) (t))) ;; First, unconditionally turn the mode OFF. (setq haskell-doc-buffers (delq (current-buffer) haskell-doc-buffers)) ;; Refresh the buffers list. (dolist (buf haskell-doc-buffers) (unless (and (buffer-live-p buf) (with-current-buffer buf haskell-doc-mode)) (setq haskell-doc-buffers (delq buf haskell-doc-buffers)))) ;; Turn off the idle timer (or idle post-command-hook). (when (and haskell-doc-timer (null haskell-doc-buffers)) (cancel-timer haskell-doc-timer) (setq haskell-doc-timer nil)) (remove-hook 'post-command-hook 'haskell-doc-mode-print-current-symbol-info 'local) (when haskell-doc-mode ;; Turning the mode ON. (push (current-buffer) haskell-doc-buffers) (if (fboundp 'run-with-idle-timer) (unless haskell-doc-timer (setq haskell-doc-timer (run-with-idle-timer haskell-doc-idle-delay t 'haskell-doc-mode-print-current-symbol-info))) (add-hook 'post-command-hook 'haskell-doc-mode-print-current-symbol-info nil 'local)) (and haskell-doc-show-global-types (haskell-doc-make-global-fct-index)) ; build type index for global fcts (haskell-doc-install-keymap) (run-hooks 'haskell-doc-mode-hook)) (and (called-interactively-p 'any) (message "haskell-doc-mode is %s" (if haskell-doc-mode "enabled" "disabled"))) haskell-doc-mode) (defmacro haskell-doc-toggle-var (id prefix) ;; toggle variable or set it based on prefix value `(setq ,id (if ,prefix (>= (prefix-numeric-value ,prefix) 0) (not ,id))) ) ;;@cindex haskell-doc-show-global-types (defun haskell-doc-show-global-types (&optional prefix) "Turn on global types information in `haskell-doc-mode'." (interactive "P") (haskell-doc-toggle-var haskell-doc-show-global-types prefix) (if haskell-doc-show-global-types (haskell-doc-make-global-fct-index))) ;;@cindex haskell-doc-show-reserved (defun haskell-doc-show-reserved (&optional prefix) "Toggle the automatic display of a doc string for reserved ids." (interactive "P") (haskell-doc-toggle-var haskell-doc-show-reserved prefix)) ;;@cindex haskell-doc-show-prelude (defun haskell-doc-show-prelude (&optional prefix) "Toggle the automatic display of a doc string for reserved ids." (interactive "P") (haskell-doc-toggle-var haskell-doc-show-prelude prefix)) ;;@cindex haskell-doc-show-strategy (defun haskell-doc-show-strategy (&optional prefix) "Toggle the automatic display of a doc string for strategy ids." (interactive "P") (haskell-doc-toggle-var haskell-doc-show-strategy prefix)) ;;@cindex haskell-doc-show-user-defined (defun haskell-doc-show-user-defined (&optional prefix) "Toggle the automatic display of a doc string for user defined ids." (interactive "P") (haskell-doc-toggle-var haskell-doc-show-user-defined prefix)) ;;@node Switch it on or off, Check, Haskell Doc Mode, top ;;@section Switch it on or off ;;@cindex turn-on-haskell-doc-mode ;;;###autoload (defalias 'turn-on-haskell-doc-mode 'haskell-doc-mode) ;;;###autoload (defalias 'turn-on-haskell-doc 'haskell-doc-mode) ;;@cindex turn-off-haskell-doc-mode (defalias 'turn-off-haskell-doc-mode 'turn-off-haskell-doc) (defun turn-off-haskell-doc () "Unequivocally turn off `haskell-doc-mode' (which see)." (haskell-doc-mode 0)) ;;@node Check, Top level function, Switch it on or off, top ;;@section Check ;;@cindex haskell-doc-check-active (defun haskell-doc-check-active () "Check whether the print function is hooked in. Should be the same as the value of `haskell-doc-mode' but alas currently it is not." (interactive) (message "%s" (if (or (and haskell-doc-mode haskell-doc-timer) (memq 'haskell-doc-mode-print-current-symbol-info post-command-hook)) "haskell-doc is ACTIVE" (substitute-command-keys "haskell-doc is not ACTIVE \(Use \\[haskell-doc-mode] to turn it on\)")))) ;;@node Top level function, Mouse interface, Check, top ;;@section Top level function ;;@cindex haskell-doc-mode-print-current-symbol-info ;; This is the function hooked into the elisp command engine (defun haskell-doc-mode-print-current-symbol-info () "Print the type of the symbol under the cursor. This function is run by an idle timer to print the type automatically if `haskell-doc-mode' is turned on." (and haskell-doc-mode (not (eobp)) (not executing-kbd-macro) ;; Having this mode operate in the minibuffer makes it impossible to ;; see what you're doing. (not (eq (selected-window) (minibuffer-window))) ;; take a nap, if run straight from post-command-hook. (if (fboundp 'run-with-idle-timer) t (sit-for haskell-doc-idle-delay)) ;; good morning! read the word under the cursor for breakfast (haskell-doc-show-type))) ;; ;; ToDo: find surrounding fct ;; (cond ((eq current-symbol current-fnsym) ;; (haskell-doc-show-type current-fnsym)) ;; (t ;; (or nil ; (haskell-doc-print-var-docstring current-symbol) ;; (haskell-doc-show-type current-fnsym))))))) ;;;###autoload (defun haskell-doc-current-info () "Return the info about symbol at point. Meant for `eldoc-documentation-function'." ;; There are a number of possible documentation functions. ;; Some of them are asynchronous. (let ((msg (or (haskell-doc-current-info--interaction) (haskell-doc-sym-doc (haskell-ident-at-point))))) (unless (symbolp msg) msg))) ;;@node Mouse interface, Print fctsym, Top level function, top ;;@section Mouse interface for interactive query ;;@cindex haskell-doc-ask-mouse-for-type (defun haskell-doc-ask-mouse-for-type (event) "Read the identifier under the mouse and echo its type. This uses the same underlying function `haskell-doc-show-type' as the hooked function. Only the user interface is different." (interactive "e") (save-excursion (select-window (posn-window (event-end event))) (goto-char (posn-point (event-end event))) (haskell-doc-show-type))) ;;@node Print fctsym, Movement, Mouse interface, top ;;@section Print fctsym ;;@menu ;;* Show type:: ;;* Aux:: ;;* Global fct type:: ;;* Local fct type:: ;;@end menu ;;@node Show type, Aux, Print fctsym, Print fctsym ;;@subsection Show type ;;@cindex haskell-doc-show-type (defun haskell-doc-in-code-p () (not (or (and (eq haskell-literate 'bird) ;; Copied from haskell-indent-bolp. (<= (current-column) 2) (eq (char-after (line-beginning-position)) ?\>)) (nth 8 (syntax-ppss))))) ;;;###autoload (defun haskell-doc-show-type (&optional sym) "Show the type of the function near point. For the function under point, show the type in the echo area. This information is extracted from the `haskell-doc-prelude-types' alist of prelude functions and their types, or from the local functions in the current buffer." (interactive) (unless sym (setq sym (haskell-ident-at-point))) ;; if printed before do not print it again (unless (string= sym (car haskell-doc-last-data)) (let ((doc (or (haskell-doc-current-info--interaction t) (haskell-doc-sym-doc sym)))) (when (and doc (haskell-doc-in-code-p)) ;; In Emacs 19.29 and later, and XEmacs 19.13 and later, all ;; messages are recorded in a log. Do not put haskell-doc messages ;; in that log since they are legion. (if (eval-when-compile (fboundp 'display-message)) ;; XEmacs 19.13 way of preventing log messages. ;;(display-message 'no-log (format )) ;; XEmacs 19.15 seems to be a bit different. (display-message 'message (format "%s" doc)) (let ((message-log-max nil)) (message "%s" doc))))))) (defvar haskell-doc-current-info--interaction-last nil "If non-nil, a previous eldoc message from an async call, that hasn't been displayed yet.") (defun haskell-doc-current-info--interaction (&optional sync) "Asynchronous call to `haskell-process-get-type', suitable for use in the eldoc function `haskell-doc-current-info'. If SYNC is non-nil, the call will be synchronous instead, and instead of calling `eldoc-print-current-symbol-info', the result will be returned directly." ;; Return nil if nothing is available, or 'async if something might ;; be available, but asynchronously later. This will call ;; `eldoc-print-current-symbol-info' later. (let (sym prev-message) (cond ((setq prev-message haskell-doc-current-info--interaction-last) (setq haskell-doc-current-info--interaction-last nil) (cdr prev-message)) ((setq sym (if (use-region-p) (buffer-substring-no-properties (region-beginning) (region-end)) (haskell-ident-at-point))) (if sync (haskell-process-get-type sym #'identity t) (haskell-process-get-type sym (lambda (response) (setq haskell-doc-current-info--interaction-last (cons 'async response)) (eldoc-print-current-symbol-info)))))))) (defun haskell-process-get-type (expr-string &optional callback sync) "Asynchronously get the type of a given string. EXPR-STRING should be an expression passed to :type in ghci. CALLBACK will be called with a formatted type string. If SYNC is non-nil, make the call synchronously instead." (unless callback (setq callback (lambda (response) (message "%s" response)))) (let ((process (and (haskell-session-maybe) (haskell-session-process (haskell-session-maybe)))) ;; Avoid passing bad strings to ghci (expr-okay (and (not (string-match-p "\\`[[:space:]]*\\'" expr-string)) (not (string-match-p "\n" expr-string)))) (ghci-command (concat ":type " expr-string)) (process-response (lambda (response) ;; Responses with empty first line are likely errors (if (string-match-p (rx string-start line-end) response) (setq response nil) ;; Remove a newline at the end (setq response (replace-regexp-in-string "\n\\'" "" response)) ;; Propertize for eldoc (save-match-data (when (string-match " :: " response) ;; Highlight type (let ((name (substring response 0 (match-end 0))) (type (propertize (substring response (match-end 0)) 'face 'eldoc-highlight-function-argument))) (setq response (concat name type))))) (when haskell-doc-prettify-types (dolist (re '(("::" . "∷") ("=>" . "⇒") ("->" . "→"))) (setq response (replace-regexp-in-string (car re) (cdr re) response)))) response)))) (when (and process expr-okay) (if sync (let ((response (haskell-process-queue-sync-request process ghci-command))) (funcall callback (funcall process-response response))) (lexical-let ((process process) (callback callback) (ghci-command ghci-command) (process-response process-response)) (haskell-process-queue-command process (make-haskell-command :go (lambda (_) (haskell-process-send-string process ghci-command)) :complete (lambda (_ response) (funcall callback (funcall process-response response)))))) 'async)))) (defun haskell-doc-sym-doc (sym) "Show the type of the function near point. For the function under point, show the type in the echo area. This information is extracted from the `haskell-doc-prelude-types' alist of prelude functions and their types, or from the local functions in the current buffer. If `haskell-doc-use-inf-haskell' is non-nil, this function will consult the inferior Haskell process for type/kind information, rather than using the haskell-doc database." (if haskell-doc-use-inf-haskell (unless (or (null sym) (string= "" sym)) (let* ((message-log-max nil) (result (ignore-errors (unwind-protect (inferior-haskell-type sym) (message ""))))) (if (and result (string-match " :: " result)) result (setq result (unwind-protect (inferior-haskell-kind sym) (message ""))) (and result (string-match " :: " result) result)))) (let ((i-am-prelude nil) (i-am-fct nil) (type nil) (is-reserved (haskell-doc-is-of sym haskell-doc-reserved-ids)) (is-prelude (haskell-doc-is-of sym haskell-doc-prelude-types)) (is-strategy (haskell-doc-is-of sym haskell-doc-strategy-ids)) (is-user-defined (haskell-doc-is-of sym haskell-doc-user-defined-ids)) (is-prelude (haskell-doc-is-of sym haskell-doc-prelude-types))) (cond ;; if reserved id (i.e. Haskell keyword ((and haskell-doc-show-reserved is-reserved) (setq type (cdr is-reserved)) (setcdr haskell-doc-last-data type)) ;; if built-in function get type from docstring ((and (not (null haskell-doc-show-prelude)) is-prelude) (setq type (cdr is-prelude)) ; (cdr (assoc sym haskell-doc-prelude-types))) (if (= 2 (length type)) ; horrible hack to remove bad formatting (setq type (car (cdr type)))) (setq i-am-prelude t) (setq i-am-fct t) (setcdr haskell-doc-last-data type)) ((and haskell-doc-show-strategy is-strategy) (setq i-am-fct t) (setq type (cdr is-strategy)) (setcdr haskell-doc-last-data type)) ((and haskell-doc-show-user-defined is-user-defined) ;; (setq i-am-fct t) (setq type (cdr is-user-defined)) (setcdr haskell-doc-last-data type)) (t (let ( (x (haskell-doc-get-and-format-fct-type sym)) ) (if (null x) (setcdr haskell-doc-last-data nil) ; if not found reset last data (setq type (car x)) (setq i-am-fct (string= "Variables" (cdr x))) (if (and haskell-doc-show-global-types (null type)) (setq type (haskell-doc-get-global-fct-type sym))) (setcdr haskell-doc-last-data type)))) ) ;; ToDo: encode i-am-fct info into alist of types (and type ;; drop `::' if it's not a fct (let ( (str (cond ((and i-am-fct (not haskell-doc-chop-off-fctname)) (format "%s :: %s" sym type)) (t (format "%s" type)))) ) (if i-am-prelude (add-text-properties 0 (length str) '(face bold) str)) str))))) ;; ToDo: define your own notion of `near' to find surrounding fct ;;(defun haskell-doc-fnsym-in-current-sexp () ;; (let* ((p (point)) ;; (sym (progn ;; (forward-word -1) ;; (while (and (forward-word -1) ; (haskell-doc-forward-sexp-safe -1) ;; (> (point) (point-min)))) ;; (cond ((or (= (point) (point-min)) ;; (memq (or (char-after (point)) 0) ;; '(?\( ?\")) ;; ;; If we hit a quotation mark before a paren, we ;; ;; are inside a specific string, not a list of ;; ;; symbols. ;; (eq (or (char-after (1- (point))) 0) ?\")) ;; nil) ;; (t (condition-case nil ;; (read (current-buffer)) ;; (error nil))))))) ;; (goto-char p) ;; (if sym ;; (format "%s" sym) ;; sym))) ;; (and (symbolp sym) ;; sym))) ;;@node Aux, Global fct type, Show type, Print fctsym ;;@subsection Aux ;; ToDo: handle open brackets to decide if it's a wrapped type ;;@cindex haskell-doc-grab-line (defun haskell-doc-grab-line (fct-and-pos) "Get the type of an \(FCT POSITION\) pair from the current buffer." ;; (if (null fct-and-pos) ;; "" ; fn is not a local fct (let ( (str "")) (goto-char (cdr fct-and-pos)) (beginning-of-line) ;; search for start of type (phsp give better bound?) (if (null (search-forward "::" (+ (point) haskell-doc-search-distance) t)) "" (setq str (haskell-doc-grab)) ; leaves point at end of line (while (haskell-doc-wrapped-type-p) ; while in a multi-line type expr (forward-line 1) (beginning-of-line) (skip-chars-forward " \t") (setq str (concat str (haskell-doc-grab)))) (haskell-doc-string-nub-ws ; squeeze string (if haskell-doc-chop-off-context ; no context (haskell-doc-chop-off-context str) str))))) ;; (concat (car fct-and-pos) "::" (haskell-doc-string-nub-ws str)))) ;;@cindex haskell-doc-wrapped-type-p (defun haskell-doc-wrapped-type-p () "Check whether the type under the cursor is wrapped over several lines. The cursor must be at the end of a line, which contains the type. Currently, only the following is checked: If this line ends with a `->' or the next starts with an `->' it is a multi-line type \(same for `=>'\). `--' comments are ignored. ToDo: Check for matching parenthesis!." (save-excursion (let ( (here (point)) (lim (progn (beginning-of-line) (point))) ;; (foo "") (res nil) ) (goto-char here) (search-backward "--" lim t) ; skip over `--' comment (skip-chars-backward " \t") (if (bolp) ; skip empty lines (progn (forward-line 1) (end-of-line) (setq res (haskell-doc-wrapped-type-p))) (forward-char -1) ;; (setq foo (concat foo (char-to-string (preceding-char)) (char-to-string (following-char)))) (if (or (and (or (char-equal (preceding-char) ?-) (char-equal (preceding-char) ?=)) (char-equal (following-char) ?>)) ; (or -!> =!> (char-equal (following-char) ?,)) ; !,) (setq res t) (forward-line) (let ((here (point))) (goto-char here) (skip-chars-forward " \t") (if (looking-at "--") ; it is a comment line (progn (forward-line 1) (end-of-line) (setq res (haskell-doc-wrapped-type-p))) (forward-char 1) ;; (setq foo (concat foo (char-to-string (preceding-char)) (char-to-string (following-char)))) ;; (message "|%s|" foo) (if (and (or (char-equal (preceding-char) ?-) (char-equal (preceding-char) ?=)) (char-equal (following-char) ?>)) ; -!> or =!> (setq res t)))))) res))) ;;@cindex haskell-doc-grab (defun haskell-doc-grab () "Return the text from point to the end of the line, chopping off comments. Leaves point at end of line." (let ((str (buffer-substring-no-properties (point) (progn (end-of-line) (point))))) (if (string-match "--" str) (substring str 0 (match-beginning 0)) str))) ;;@cindex haskell-doc-string-nub-ws (defun haskell-doc-string-nub-ws (str) "Replace all sequences of whitespace in STR by just one space. ToDo: Also eliminate leading and trailing whitespace." (let ((i -1)) (while (setq i (string-match " [ \t\n]+\\|[\t\n]+" str (1+ i))) (setq str (replace-match " " t t str))) str)) ;; ToDo: make this more efficient!! ;;(defun haskell-doc-string-nub-ws (str) ;; "Replace all sequences of whitespaces in STR by just one whitespace." ;; (let ( (res "") ;; (l (length str)) ;; (i 0) ;; (j 0) ;; (in-ws nil)) ;; (while (< i l) ;; (let* ( (c (string-to-char (substring str i (1+ i)))) ;; (is-ws (eq (char-syntax c) ? )) ) ;; (if (not (and in-ws is-ws)) ;; (setq res (concat res (char-to-string c)))) ;; (setq in-ws is-ws) ;; (setq i (1+ i)))) ;; res)) ;;@cindex haskell-doc-chop-off-context (defun haskell-doc-chop-off-context (str) "Eliminate the context in a type represented by the string STR." (let ((i (string-match "=>" str)) ) (if (null i) str (substring str (+ i 2))))) ;;@cindex haskell-doc-get-imenu-info (defun haskell-doc-get-imenu-info (obj kind) "Return a string describing OBJ of KIND \(Variables, Types, Data\)." (cond ((eq major-mode 'haskell-mode) (let* ((imenu-info-alist (cdr (assoc kind imenu--index-alist))) ;; (names (mapcar 'car imenu-info-alist)) (x (assoc obj imenu-info-alist))) (when x (haskell-doc-grab-line x)))) (t ;; (error "Cannot get local functions in %s mode, sorry" major-mode))) nil))) ;;@node Global fct type, Local fct type, Aux, Print fctsym ;;@subsection Global fct type ;; ToDo: ;; - modular way of defining a mapping of module name to file ;; - use a path to search for file (not just current directory) ;;@cindex haskell-doc-imported-list (defun haskell-doc-imported-list () "Return a list of the imported modules in current buffer." (interactive "fName of outer `include' file: ") ; (buffer-file-name)) ;; Don't add current buffer to the imported file list if it is not (yet?) ;; visiting a file since it leads to errors further down. (let ((imported-file-list (and buffer-file-name (list buffer-file-name)))) (widen) (goto-char (point-min)) (while (re-search-forward "^\\s-*import\\s-+\\([^ \t\n]+\\)" nil t) (let ((basename (match-string 1))) (dolist (ext '(".hs" ".lhs")) (let ((file (concat basename ext))) (if (file-exists-p file) (push file imported-file-list)))))) (nreverse imported-file-list) ;;(message imported-file-list) )) ;; ToDo: generalise this to "Types" etc (not just "Variables") ;;@cindex haskell-doc-rescan-files (defun haskell-doc-rescan-files (filelist) "Do an `imenu' rescan on every file in FILELIST and return the fct-list. This function switches to and potentially loads many buffers." (save-current-buffer (mapcar (lambda (f) (set-buffer (find-file-noselect f)) (imenu--make-index-alist t) (cons f (mapcar (lambda (x) `(,(car x) . ,(haskell-doc-grab-line x))) (cdr (assoc "Variables" imenu--index-alist))))) filelist))) ;;@cindex haskell-doc-make-global-fct-index (defun haskell-doc-make-global-fct-index () "Scan imported files for types of global fcts and update `haskell-doc-index'." (interactive) (setq haskell-doc-index (haskell-doc-rescan-files (haskell-doc-imported-list)))) ;; ToDo: use a separate munge-type function to format type concisely ;;@cindex haskell-doc-get-global-fct-type (defun haskell-doc-get-global-fct-type (&optional sym) "Get type for function symbol SYM by examining `haskell-doc-index'." (interactive) ; "fName of outer `include' file: \nsFct:") (save-excursion ;; (switch-to-buffer "*scratch*") ;; (goto-char (point-max)) ;; ;; Produces a list of fct-type alists ;; (if (null sym) ;; (setq sym (progn (forward-word -1) (read (current-buffer))))) (or sym (current-word)) (let* ( (fn sym) ; (format "%s" sym)) (fal haskell-doc-index) (res "") ) (while (not (null fal)) (let* ( (l (car fal)) (f (car l)) (x (assoc fn (cdr l))) ) (if (not (null x)) (let* ( (ty (cdr x)) ; the type as string (idx (string-match "::" ty)) (str (if (null idx) ty (substring ty (+ idx 2)))) ) (setq res (format "[%s] %s" f str)))) (setq fal (cdr fal)))) res))) ; (message res)) ) ;;@node Local fct type, , Global fct type, Print fctsym ;;@subsection Local fct type ;;@cindex haskell-doc-get-and-format-fct-type (defun haskell-doc-get-and-format-fct-type (fn) "Get the type and kind of FN by checking local and global functions." (save-excursion (save-match-data (let ((docstring "") (doc nil) ) ;; is it a local function? (setq docstring (haskell-doc-get-imenu-info fn "Variables")) (if (not (null docstring)) ;; (string-match (format "^%s\\s-+::\\s-+\\(.*\\)$" fn) docstring)) (setq doc `(,docstring . "Variables"))) ; `(,(match-string 1 docstring) . "Variables") )) ;; is it a type declaration? (setq docstring (haskell-doc-get-imenu-info fn "Types")) (if (not (null docstring)) ;; (string-match (format "^\\s-*type\\s-+%s.*$" fn) docstring)) (setq doc `(,docstring . "Types"))) ; `(,(match-string 0 docstring) . "Types")) ) (if (not (null docstring)) ;; (string-match (format "^\\s-*data.*%s.*$" fn) docstring)) (setq doc `(,docstring . "Data"))) ; (setq doc `(,(match-string 0 docstring) . "Data")) ) ;; return the result doc )))) ;;@appendix ;;@node Index, Token, Visit home site, top ;;@section Index ;;@index ;;* haskell-doc-ask-mouse-for-type:: ;;* haskell-doc-check-active:: ;;* haskell-doc-chop-off-context:: ;;* haskell-doc-get-and-format-fct-type:: ;;* haskell-doc-get-global-fct-type:: ;;* haskell-doc-get-imenu-info:: ;;* haskell-doc-grab:: ;;* haskell-doc-grab-line:: ;;* haskell-doc-imported-list:: ;;* haskell-doc-install-keymap:: ;;* haskell-doc-is-of:: ;;* haskell-doc-make-global-fct-index:: ;;* haskell-doc-mode:: ;;* haskell-doc-mode-print-current-symbol-info:: ;;* haskell-doc-prelude-types:: ;;* haskell-doc-rescan-files:: ;;* haskell-doc-reserved-ids:: ;;* haskell-doc-show-global-types:: ;;* haskell-doc-show-prelude:: ;;* haskell-doc-show-reserved:: ;;* haskell-doc-show-strategy:: ;;* haskell-doc-show-type:: ;;* haskell-doc-show-user-defined:: ;;* haskell-doc-strategy-ids:: ;;* haskell-doc-string-nub-ws:: ;;* haskell-doc-submit-bug-report:: ;;* haskell-doc-visit-home:: ;;* haskell-doc-wrapped-type-p:: ;;* turn-off-haskell-doc-mode:: ;;* turn-on-haskell-doc-mode:: ;;@end index ;;@node Token, , Index, top ;;@section Token (provide 'haskell-doc) ;;; haskell-doc.el ends here haskell-mode-13.14.2/haskell-font-lock.el000066400000000000000000000573711253441665600201170ustar00rootroot00000000000000;;; haskell-font-lock.el --- Font locking module for Haskell Mode ;; Copyright 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ;; Copyright 1997-1998 Graeme E Moss, and Tommy Thorn ;; Author: 1997-1998 Graeme E Moss ;; 1997-1998 Tommy Thorn ;; 2003 Dave Love ;; Keywords: faces files Haskell ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: (require 'cl-lib) (require 'haskell-mode) (require 'font-lock) (defcustom haskell-font-lock-symbols nil "Display \\ and -> and such using symbols in fonts. This may sound like a neat trick, but be extra careful: it changes the alignment and can thus lead to nasty surprises w.r.t layout." :group 'haskell :type 'boolean) (defconst haskell-font-lock-symbols-alist '(("\\" . "λ") ("not" . "¬") ("->" . "→") ("<-" . "←") ("=>" . "⇒") ("()" . "∅") ("==" . "≡") ("/=" . "≢") (">=" . "≥") ("<=" . "≤") ("!!" . "‼") ("&&" . "∧") ("||" . "∨") ("sqrt" . "√") ("undefined" . "⊥") ("pi" . "π") ("~>" . "⇝") ;; Omega language ;; ("~>" "↝") ;; less desirable ("-<" . "↢") ;; Paterson's arrow syntax ;; ("-<" "⤙") ;; nicer but uncommon ("::" . "∷") ("." "∘" ; "○" ;; Need a predicate here to distinguish the . used by ;; forall . . haskell-font-lock-dot-is-not-composition) ("forall" . "∀")) "Alist mapping Haskell symbols to chars. Each element has the form (STRING . COMPONENTS) or (STRING COMPONENTS PREDICATE). STRING is the Haskell symbol. COMPONENTS is a representation specification suitable as an argument to `compose-region'. PREDICATE if present is a function of one argument (the start position of the symbol) which should return non-nil if this mapping should be disabled at that position.") (defun haskell-font-lock-dot-is-not-composition (start) "Return non-nil if the \".\" at START is not a composition operator. This is the case if the \".\" is part of a \"forall . \"." (save-excursion (goto-char start) (or (re-search-backward "\\[^.\"]*\\=" (line-beginning-position) t) (not (or (string= " " (string (char-after start))) (string= " " (string (char-before start)))))))) (defface haskell-keyword-face '((t :inherit font-lock-keyword-face)) "Face used to highlight Haskell keywords." :group 'haskell) (defface haskell-constructor-face '((t :inherit font-lock-type-face)) "Face used to highlight Haskell constructors." :group 'haskell) ;; This used to be `font-lock-variable-name-face' but it doesn't result in ;; a highlighting that's consistent with other modes (it's mostly used ;; for function defintions). (defface haskell-definition-face '((t :inherit font-lock-function-name-face)) "Face used to highlight Haskell definitions." :group 'haskell) ;; This is probably just wrong, but it used to use ;; `font-lock-function-name-face' with a result that was not consistent with ;; other major modes, so I just exchanged with `haskell-definition-face'. (defface haskell-operator-face '((t :inherit font-lock-variable-name-face)) "Face used to highlight Haskell operators." :group 'haskell) (defface haskell-pragma-face '((t :inherit font-lock-preprocessor-face)) "Face used to highlight Haskell pragmas." :group 'haskell) (defface haskell-literate-comment-face '((t :inherit font-lock-doc-face)) "Face with which to fontify literate comments. Inherit from `default' to avoid fontification of them." :group 'haskell) (defun haskell-font-lock-compose-symbol (alist) "Compose a sequence of ascii chars into a symbol. Regexp match data 0 points to the chars." ;; Check that the chars should really be composed into a symbol. (let* ((start (match-beginning 0)) (end (match-end 0)) (syntaxes (cond ((eq (char-syntax (char-after start)) ?w) '(?w)) ((eq (char-syntax (char-after start)) ?.) '(?.)) ;; Special case for the . used for qualified names. ((and (eq (char-after start) ?\.) (= end (1+ start))) '(?_ ?\\ ?w)) (t '(?_ ?\\)))) sym-data) (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes) (memq (char-syntax (or (char-after end) ?\ )) syntaxes) (or (elt (syntax-ppss) 3) (elt (syntax-ppss) 4)) (and (consp (setq sym-data (cdr (assoc (match-string 0) alist)))) (let ((pred (cadr sym-data))) (setq sym-data (car sym-data)) (funcall pred start)))) ;; No composition for you. Let's actually remove any composition ;; we may have added earlier and which is now incorrect. (remove-text-properties start end '(composition)) ;; That's a symbol alright, so add the composition. (compose-region start end sym-data))) ;; Return nil because we're not adding any face property. nil) (defun haskell-font-lock-symbols-keywords () (when (and haskell-font-lock-symbols haskell-font-lock-symbols-alist (fboundp 'compose-region)) `((,(regexp-opt (mapcar 'car haskell-font-lock-symbols-alist) t) (0 (haskell-font-lock-compose-symbol ',haskell-font-lock-symbols-alist) ;; In Emacs-21, if the `override' field is nil, the face ;; expressions is only evaluated if the text has currently ;; no face. So force evaluation by using `keep'. keep))))) ;; The font lock regular expressions. (defun haskell-font-lock-keywords-create (literate) "Create fontification definitions for Haskell scripts. Returns keywords suitable for `font-lock-keywords'." (let* (;; Bird-style literate scripts start a line of code with ;; "^>", otherwise a line of code starts with "^". (line-prefix (if (eq literate 'bird) "^> ?" "^")) (varid "\\b[[:lower:]_][[:alnum:]'_]*\\b") ;; We allow ' preceding conids because of DataKinds/PolyKinds (conid "\\b'?[[:upper:]][[:alnum:]'_]*\\b") (modid (concat "\\b" conid "\\(\\." conid "\\)*\\b")) (qvarid (concat modid "\\." varid)) (qconid (concat modid "\\." conid)) (sym "\\s.+") ;; Reserved identifiers (reservedid (concat "\\<" ;; `as', `hiding', and `qualified' are part of the import ;; spec syntax, but they are not reserved. ;; `_' can go in here since it has temporary word syntax. ;; (regexp-opt ;; '("case" "class" "data" "default" "deriving" "do" ;; "else" "if" "import" "in" "infix" "infixl" ;; "infixr" "instance" "let" "module" "newtype" "of" ;; "then" "type" "where" "_") t) "\\(_\\|c\\(ase\\|lass\\)\\|d\\(ata\\|e\\(fault\\|riving\\)\\|o\\)\\|else\\|i\\(mport\\|n\\(fix[lr]?\\|stance\\)\\|[fn]\\)\\|let\\|module\\|mdo\\|newtype\\|of\\|rec\\|proc\\|t\\(hen\\|ype\\)\\|where\\)" "\\>")) ;; Top-level declarations (topdecl-var (concat line-prefix "\\(" varid "\\(?:\\s-*,\\s-*" varid "\\)*" "\\)\\s-*" ;; optionally allow for a single newline after identifier ;; NOTE: not supported for bird-style .lhs files (if (eq literate 'bird) nil "\\([\n]\\s-+\\)?") ;; A toplevel declaration can be followed by a definition ;; (=), a type (::) or (∷), a guard, or a pattern which can ;; either be a variable, a constructor, a parenthesized ;; thingy, or an integer or a string. "\\(" varid "\\|" conid "\\|::\\|∷\\|=\\||\\|\\s(\\|[0-9\"']\\)")) (topdecl-var2 (concat line-prefix "\\(" varid "\\|" conid "\\)\\s-*`\\(" varid "\\)`")) (topdecl-bangpat (concat line-prefix "\\(" varid "\\)\\s-*!")) (topdecl-sym (concat line-prefix "\\(" varid "\\|" conid "\\)\\s-*\\(" sym "\\)")) (topdecl-sym2 (concat line-prefix "(\\(" sym "\\))")) keywords) (setq keywords `(;; NOTICE the ordering below is significant ;; ("^#.*$" 0 'font-lock-preprocessor-face t) ,@(haskell-font-lock-symbols-keywords) (,reservedid 1 'haskell-keyword-face) ;; Special case for `as', `hiding', `safe' and `qualified', which are ;; keywords in import statements but are not otherwise reserved. ("\\\\)[ \t]*\\)?\\(?:\\(qualified\\>\\)[ \t]*\\)?\\(?:\"[^\"]*\"[\t ]*\\)?[^ \t\n()]+[ \t]*\\(?:\\(\\\\)[ \t]*[^ \t\n()]+[ \t]*\\)?\\(\\\\)?" (1 'haskell-keyword-face nil lax) (2 'haskell-keyword-face nil lax) (3 'haskell-keyword-face nil lax) (4 'haskell-keyword-face nil lax)) ;; Special case for `foreign import' ;; keywords in foreign import statements but are not otherwise reserved. ("\\<\\(foreign\\)[ \t]+\\(import\\)[ \t]+\\(?:\\(ccall\\|stdcall\\|cplusplus\\|jvm\\|dotnet\\)[ \t]+\\)?\\(?:\\(safe\\|unsafe\\|interruptible\\)[ \t]+\\)?" (1 'haskell-keyword-face nil lax) (2 'haskell-keyword-face nil lax) (3 'haskell-keyword-face nil lax) (4 'haskell-keyword-face nil lax)) ;; Special case for `foreign export' ;; keywords in foreign export statements but are not otherwise reserved. ("\\<\\(foreign\\)[ \t]+\\(export\\)[ \t]+\\(?:\\(ccall\\|stdcall\\|cplusplus\\|jvm\\|dotnet\\)[ \t]+\\)?" (1 'haskell-keyword-face nil lax) (2 'haskell-keyword-face nil lax) (3 'haskell-keyword-face nil lax)) ;; Toplevel Declarations. ;; Place them *before* generic id-and-op highlighting. (,topdecl-var (1 'haskell-definition-face)) (,topdecl-var2 (2 'haskell-definition-face)) (,topdecl-bangpat (1 'haskell-definition-face)) (,topdecl-sym (2 (unless (member (match-string 2) '("\\" "=" "->" "→" "<-" "←" "::" "∷" "," ";" "`")) 'haskell-definition-face))) (,topdecl-sym2 (1 (unless (member (match-string 1) '("\\" "=" "->" "→" "<-" "←" "::" "∷" "," ";" "`")) 'haskell-definition-face))) ;; These four are debatable... ("(\\(,*\\|->\\))" 0 'haskell-constructor-face) ("\\[\\]" 0 'haskell-constructor-face) (,(concat "`" varid "`") 0 'haskell-operator-face) (,(concat "`" conid "`") 0 'haskell-operator-face) (,(concat "`" qvarid "`") 0 'haskell-operator-face) (,(concat "`" qconid "`") 0 'haskell-operator-face) (,qconid 0 'haskell-constructor-face) (,conid 0 'haskell-constructor-face) (,sym 0 (if (and (eq (char-after (match-beginning 0)) ?:) (not (member (match-string 0) '("::" "∷")))) 'haskell-constructor-face 'haskell-operator-face)))) keywords)) (defvar haskell-font-lock-latex-cache-pos nil "Position of cache point used by `haskell-font-lock-latex-cache-in-comment'. Should be at the start of a line.") (make-variable-buffer-local 'haskell-font-lock-latex-cache-pos) (defvar haskell-font-lock-latex-cache-in-comment nil "If `haskell-font-lock-latex-cache-pos' is outside a \\begin{code}..\\end{code} block (and therefore inside a comment), this variable is set to t, otherwise nil.") (make-variable-buffer-local 'haskell-font-lock-latex-cache-in-comment) (defun haskell-font-lock-latex-comments (end) "Sets `match-data' according to the region of the buffer before end that should be commented under LaTeX-style literate scripts." (let ((start (point))) (if (= start end) ;; We're at the end. No more to fontify. nil (if (not (eq start haskell-font-lock-latex-cache-pos)) ;; If the start position is not cached, calculate the state ;; of the start. (progn (setq haskell-font-lock-latex-cache-pos start) ;; If the previous \begin{code} or \end{code} is a ;; \begin{code}, then start is not in a comment, otherwise ;; it is in a comment. (setq haskell-font-lock-latex-cache-in-comment (if (and (re-search-backward "^\\(\\(\\\\begin{code}\\)\\|\\(\\\\end{code}\\)\\)$" (point-min) t) (match-end 2)) nil t)) ;; Restore position. (goto-char start))) (if haskell-font-lock-latex-cache-in-comment (progn ;; If start is inside a comment, search for next \begin{code}. (re-search-forward "^\\\\begin{code}$" end 'move) ;; Mark start to end of \begin{code} (if present, till end ;; otherwise), as a comment. (set-match-data (list start (point))) ;; Return point, as a normal regexp would. (point)) ;; If start is inside a code block, search for next \end{code}. (if (re-search-forward "^\\\\end{code}$" end t) ;; If one found, mark it as a comment, otherwise finish. (point)))))) (defconst haskell-basic-syntactic-keywords '(;; Character constants (since apostrophe can't have string syntax). ;; Beware: do not match something like 's-}' or '\n"+' since the first ' ;; might be inside a comment or a string. ;; This still gets fooled with "'"'"'"'"'"', but ... oh well. ("\\Sw\\('\\)\\([^\\'\n]\\|\\\\.[^\\'\n \"}]*\\)\\('\\)" (1 "\"") (3 "\"")) ;; Deal with instances of `--' which don't form a comment ("[!#$%&*+./:<=>?@^|~\\-]\\{3,\\}" (0 (cond ((or (nth 3 (syntax-ppss)) (numberp (nth 4 (syntax-ppss)))) ;; There are no such instances inside nestable comments or strings nil) ((string-match "\\`-*\\'" (match-string 0)) ;; Sequence of hyphens. Do nothing in ;; case of things like `{---'. nil) (t ".")))) ; other symbol sequence ;; Implement Haskell Report 'escape' and 'gap' rules. Backslash ;; inside of a string is escaping unless it is preceeded by ;; another escaping backslash. There can be whitespace between ;; those two. ;; ;; Backslashes outside of string never escape. ;; ;; Note that (> 0 (skip-syntax-backward ".")) this skips over *escaping* ;; backslashes only. ("\\\\" (0 (when (save-excursion (and (nth 3 (syntax-ppss)) (goto-char (match-beginning 0)) (skip-syntax-backward "->") (or (not (eq ?\\ (char-before))) (> 0 (skip-syntax-backward "."))))) "\\"))) ;; QuasiQuotes syntax: [quoter| string |], quoter is unqualified ;; name, no spaces, string is arbitrary (including newlines), ;; finishes at the first occurence of |], no escaping is provided. ;; ;; The quoter cannot be "e", "t", "d", or "p", since those overlap ;; with Template Haskell quotations. ;; ;; QuasiQuotes opens only when outside of a string or a comment ;; and closes only when inside a quasiquote. ;; ;; (syntax-ppss) returns list with two imteresting elements: ;; nth 3. non-nil if inside a string. (it is the character that will ;; terminate the string, or t if the string should be terminated ;; by a generic string delimiter.) ;; nth 4. nil if outside a comment, t if inside a non-nestable comment, ;; else an integer (the current comment nesting). ;; ;; Note also that we need to do in in a single pass, hence a regex ;; that covers both the opening and the ending of a quasiquote. ("\\(\\[[[:alnum:]]+\\)?\\(|\\)\\(?:]\\)?" (2 (save-excursion (goto-char (match-beginning 0)) (if (eq ?\[ (char-after)) ;; opening case (unless (or (nth 3 (syntax-ppss)) (nth 4 (syntax-ppss)) (member (match-string 1) '("[e" "[t" "[d" "[p"))) "|") ;; closing case (when (eq t (nth 3 (syntax-ppss))) "|"))))) )) (defconst haskell-bird-syntactic-keywords (cons '("^[^\n>]" (0 "<")) haskell-basic-syntactic-keywords)) (defconst haskell-latex-syntactic-keywords (append '(("^\\\\begin{code}\\(\n\\)" 1 "!") ;; Note: buffer is widened during font-locking. ("\\`\\(.\\|\n\\)" (1 "!")) ; start comment at buffer start ("^\\(\\\\\\)end{code}$" 1 "!")) haskell-basic-syntactic-keywords)) (defun haskell-syntactic-face-function (state) "`font-lock-syntactic-face-function' for Haskell." (cond ((nth 3 state) 'font-lock-string-face) ; as normal ;; Else comment. If it's from syntax table, use default face. ((or (eq 'syntax-table (nth 7 state)) (and (eq haskell-literate 'bird) (memq (char-before (nth 8 state)) '(nil ?\n)))) 'haskell-literate-comment-face) ;; Detect pragmas. A pragma is enclosed in special comment ;; delimeters {-# .. #-}. ((save-excursion (goto-char (nth 8 state)) (and (looking-at "{-#") (forward-comment 1) (goto-char (- (point) 3)) (looking-at "#-}"))) 'haskell-pragma-face) ;; Haddock comment start with either "-- [|^*$]" or "{- ?[|^*$]" ;; (note space optional for nested comments and mandatory for ;; double dash comments). ;; ;; Haddock comment will also continue on next line, provided: ;; - current line is a double dash haddock comment ;; - next line is also double dash comment ;; - there is only whitespace between ;; ;; We recognize double dash haddock comments by property ;; 'font-lock-doc-face attached to newline. In case of bounded ;; comments newline is outside of comment. ((save-excursion (goto-char (nth 8 state)) (or (looking-at "\\(?:{- ?\\|-- \\)[|^*$]") (and (looking-at "--") ; are we at double dash comment (forward-line -1) ; this is nil on first line (eq (get-text-property (line-end-position) 'face) 'font-lock-doc-face) ; is a doc face (forward-line) (skip-syntax-forward "-") ; see if there is only whitespace (eq (point) (nth 8 state))))) ; we are back in position 'font-lock-doc-face) (t 'font-lock-comment-face))) (defconst haskell-font-lock-keywords (haskell-font-lock-keywords-create nil) "Font lock definitions for non-literate Haskell.") (defconst haskell-font-lock-bird-literate-keywords (haskell-font-lock-keywords-create 'bird) "Font lock definitions for Bird-style literate Haskell.") (defconst haskell-font-lock-latex-literate-keywords (haskell-font-lock-keywords-create 'latex) "Font lock definitions for LaTeX-style literate Haskell.") ;;;###autoload (defun haskell-font-lock-choose-keywords () (let ((literate (if (boundp 'haskell-literate) haskell-literate))) (cl-case literate (bird haskell-font-lock-bird-literate-keywords) ((latex tex) haskell-font-lock-latex-literate-keywords) (t haskell-font-lock-keywords)))) (defun haskell-font-lock-choose-syntactic-keywords () (let ((literate (if (boundp 'haskell-literate) haskell-literate))) (cl-case literate (bird haskell-bird-syntactic-keywords) ((latex tex) haskell-latex-syntactic-keywords) (t haskell-basic-syntactic-keywords)))) (defun haskell-font-lock-defaults-create () "Locally set `font-lock-defaults' for Haskell." (set (make-local-variable 'font-lock-defaults) '(haskell-font-lock-choose-keywords nil nil ((?\' . "w") (?_ . "w")) nil (font-lock-syntactic-keywords . haskell-font-lock-choose-syntactic-keywords) (font-lock-syntactic-face-function . haskell-syntactic-face-function) ;; Get help from font-lock-syntactic-keywords. (parse-sexp-lookup-properties . t)))) ;; The main functions. (defun turn-on-haskell-font-lock () "Turns on font locking in current buffer for Haskell 1.4 scripts. Changes the current buffer's `font-lock-defaults', and adds the following variables: `haskell-keyword-face' for reserved keywords and syntax, `haskell-constructor-face' for data- and type-constructors, class names, and module names, `haskell-operator-face' for symbolic and alphanumeric operators, `haskell-default-face' for ordinary code. The variables are initialised to the following font lock default faces: `haskell-keyword-face' `font-lock-keyword-face' `haskell-constructor-face' `font-lock-type-face' `haskell-operator-face' `font-lock-function-name-face' `haskell-default-face' Two levels of fontification are defined: level one (the default) and level two (more colour). The former does not colour operators. Use the variable `font-lock-maximum-decoration' to choose non-default levels of fontification. For example, adding this to .emacs: (setq font-lock-maximum-decoration '((haskell-mode . 2) (t . 0))) uses level two fontification for `haskell-mode' and default level for all other modes. See documentation on this variable for further details. To alter an attribute of a face, add a hook. For example, to change the foreground colour of comments to brown, add the following line to .emacs: (add-hook 'haskell-font-lock-hook (lambda () (set-face-foreground 'haskell-comment-face \"brown\"))) Note that the colours available vary from system to system. To see what colours are available on your system, call `list-colors-display' from emacs. To turn font locking on for all Haskell buffers, add this to .emacs: (add-hook 'haskell-mode-hook 'turn-on-haskell-font-lock) To turn font locking on for the current buffer, call `turn-on-haskell-font-lock'. To turn font locking off in the current buffer, call `turn-off-haskell-font-lock'. Bird-style literate Haskell scripts are supported: If the value of `haskell-literate-bird-style' (automatically set by the Haskell mode of Moss&Thorn) is non-nil, a Bird-style literate script is assumed. Invokes `haskell-font-lock-hook' if not nil." (haskell-font-lock-defaults-create) (run-hooks 'haskell-font-lock-hook) (turn-on-font-lock)) (defun turn-off-haskell-font-lock () "Turns off font locking in current buffer." (font-lock-mode -1)) (defun haskell-fontify-as-mode (text mode) "Fontify TEXT as MODE, returning the fontified text." (with-temp-buffer (funcall mode) (insert text) (if (fboundp 'font-lock-ensure) (font-lock-ensure) (with-no-warnings (font-lock-fontify-buffer))) (buffer-substring (point-min) (point-max)))) ;; Provide ourselves: (provide 'haskell-font-lock) ;; Local Variables: ;; coding: utf-8-unix ;; tab-width: 8 ;; End: ;;; haskell-font-lock.el ends here haskell-mode-13.14.2/haskell-indent.el000066400000000000000000002100611253441665600174670ustar00rootroot00000000000000;;; haskell-indent.el --- "semi-intelligent" indentation module for Haskell Mode ;; Copyright 2004, 2005, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Copyright 1997-1998 Guy Lapalme ;; Author: 1997-1998 Guy Lapalme ;; Keywords: indentation Haskell layout-rule ;; URL: http://www.iro.umontreal.ca/~lapalme/layout/index.html ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; Purpose: ;; ;; To support automatic indentation of Haskell programs using ;; the layout rule described in section 1.5 and appendix B.3 of the ;; the Haskell report. The rationale and the implementation principles ;; are described in an article to appear in Journal of Functional Programming. ;; "Dynamic tabbing for automatic indentation with the layout rule" ;; ;; It supports literate scripts. ;; Haskell indentation is performed ;; within \begin{code}...\end{code} sections of a literate script ;; and in lines beginning with > with Bird style literate script ;; TAB aligns to the left column outside of these sections. ;; ;; Installation: ;; ;; To turn indentation on for all Haskell buffers under the Haskell ;; mode of Moss&Thorn ;; add this to .emacs: ;; ;; (add-hook 'haskell-mode-hook 'turn-on-haskell-indent) ;; ;; Otherwise, call `turn-on-haskell-indent'. ;; ;; ;; Customisation: ;; The "standard" offset for statements is 4 spaces. ;; It can be changed by setting the variable "haskell-indent-offset" to ;; another value ;; ;; The default number of blanks after > in a Bird style literate script ;; is 1; it can be changed by setting the variable ;; "haskell-indent-literate-Bird-default-offset" ;; ;; `haskell-indent-hook' is invoked if not nil. ;; ;; All functions/variables start with ;; `(turn-(on/off)-)haskell-indent' or `haskell-indent-'. ;; This file can also be used as a hook for the Hugs Mode developed by ;; Chris Van Humbeeck ;; It can be obtained at: ;; http://www-i2.informatik.rwth-aachen.de/Forschung/FP/Haskell/hugs-mode.el ;; ;; For the Hugs mode put the following in your .emacs ;; ;;(setq auto-mode-alist (append auto-mode-alist '(("\\.hs\\'" . hugs-mode)))) ;;(autoload 'hugs-mode "hugs-mode" "Go into hugs mode" t) ;; ;; If only the indentation mode is used then replace the two ;; preceding lines with ;;(setq auto-mode-alist (append auto-mode-alist ;; '(("\\.hs\\'" . turn-on-haskell-indent)))) ;;(autoload 'turn-on-haskell-indent "hindent" "Indentation mode for Haskell" t) ;; ;; For indentation in both cases then add the following to your .emacs ;;(add-hook 'hugs-mode-hook 'turn-on-haskell-indent) ;;(autoload 'haskell-indent-cycle "hindent" "Indentation cycle for Haskell" t) ;; ;;; Code: (require 'cl-lib) (require 'haskell-string) (defvar haskell-literate) (defgroup haskell-indent nil "Haskell indentation." :group 'haskell :link '(custom-manual "(haskell-mode)Indentation") :prefix "haskell-indent-") (defcustom haskell-indent-offset 4 "Indentation of Haskell statements with respect to containing block." :type 'integer :safe #'natnump :group 'haskell-indent) (defcustom haskell-indent-literate-Bird-default-offset 1 "Default number of blanks after > in a Bird style literate script." :type 'integer :safe #'natnump :group 'haskell-indent) (defcustom haskell-indent-rhs-align-column 0 "Column on which to align right-hand sides (use 0 for ad-hoc alignment)." :type 'integer :safe #'natnump :group 'haskell-indent) (defun haskell-indent-point-to-col (apoint) "Return the column number of APOINT." (save-excursion (goto-char apoint) (current-column))) (defconst haskell-indent-start-keywords-re (concat "\\<" (regexp-opt '("class" "data" "import" "infix" "infixl" "infixr" "instance" "module" "newtype" "primitive" "type") t) "\\>") "Regexp for keywords to complete when standing at the first word of a line.") ;; Customizations for different kinds of environments ;; in which dealing with low-level events are different. (defun haskell-indent-mark-active () (if (featurep 'xemacs) (if zmacs-regions zmacs-region-active-p t) mark-active)) ;; for pushing indentation information (defvar haskell-indent-info) ;Used with dynamic scoping. (defun haskell-indent-push-col (col &optional name) "Push indentation information for the column COL. The info is followed by NAME (if present). Makes sure that the same indentation info is not pushed twice. Uses free var `haskell-indent-info'." (let ((tmp (cons col name))) (if (member tmp haskell-indent-info) haskell-indent-info (push tmp haskell-indent-info)))) (defun haskell-indent-push-pos (pos &optional name) "Push indentation information for POS followed by NAME (if present)." (haskell-indent-push-col (haskell-indent-point-to-col pos) name)) ;; (defvar haskell-indent-tab-align nil ;; "Align all indentations on TAB stops.") (defun haskell-indent-column+offset (column offset) (unless offset (setq offset haskell-indent-offset)) (setq column (+ column offset)) ;; (if (and haskell-indent-tab-align (> offset 0)) ;; (* 8 (/ (+ column 7) 8)) column) ;; ) (defun haskell-indent-push-pos-offset (pos &optional offset) "Pushes indentation information for the column corresponding to POS followed by an OFFSET (if present use its value otherwise use `haskell-indent-offset')." (haskell-indent-push-col (haskell-indent-column+offset (haskell-indent-point-to-col pos) offset))) ;; redefinition of some Emacs function for dealing with ;; Bird Style literate scripts (defun haskell-indent-bolp () "`bolp' but dealing with Bird-style literate scripts." (or (bolp) (and (eq haskell-literate 'bird) (<= (current-column) (1+ haskell-indent-literate-Bird-default-offset)) (eq (char-after (line-beginning-position)) ?\>)))) (defun haskell-indent-empty-line-p () "Checks if the current line is empty; deals with Bird style scripts." (save-excursion (beginning-of-line) (if (and (eq haskell-literate 'bird) (eq (following-char) ?\>)) (forward-char 1)) (looking-at "[ \t]*$"))) (defun haskell-indent-back-to-indentation () "`back-to-indentation' function but dealing with Bird-style literate scripts." (if (and (eq haskell-literate 'bird) (progn (beginning-of-line) (eq (following-char) ?\>))) (progn (forward-char 1) (skip-chars-forward " \t")) (back-to-indentation))) (defun haskell-indent-current-indentation () "`current-indentation' function dealing with Bird-style literate scripts." (if (eq haskell-literate 'bird) (save-excursion (haskell-indent-back-to-indentation) (current-column)) (current-indentation))) (defun haskell-indent-backward-to-indentation (n) "`backward-to-indentation' function dealing with Bird-style literate scripts." (if (eq haskell-literate 'bird) (progn (forward-line (- n)) (haskell-indent-back-to-indentation)) (backward-to-indentation n))) (defun haskell-indent-forward-line (&optional n) "`forward-line' function but dealing with Bird-style literate scripts." (prog1 (forward-line n) (if (and (eq haskell-literate 'bird) (eq (following-char) ?\>)) (progn (forward-char 1) ; skip > and initial blanks... (skip-chars-forward " \t"))))) (defun haskell-indent-line-to (n) "`indent-line-to' function but dealing with Bird-style literate scripts." (if (eq haskell-literate 'bird) (progn (beginning-of-line) (if (eq (following-char) ?\>) (delete-char 1)) (delete-horizontal-space) ; remove any starting TABs so (indent-line-to n) ; that indent-line only adds spaces (save-excursion (beginning-of-line) (if (> n 0) (delete-char 1)) ; delete the first space before (insert ?\>))) ; inserting a > (indent-line-to n))) (defun haskell-indent-skip-blanks-and-newlines-forward (end) "Skip forward blanks, tabs and newlines until END. Take account of Bird-style literate scripts." (skip-chars-forward " \t\n" end) (if (eq haskell-literate 'bird) (while (and (bolp) (eq (following-char) ?\>)) (forward-char 1) ; skip > (skip-chars-forward " \t\n" end)))) (defun haskell-indent-skip-blanks-and-newlines-backward (start) "Skip backward blanks, tabs and newlines up to START. Take account of Bird-style literate scripts." (skip-chars-backward " \t\n" start) (if (eq haskell-literate 'bird) (while (and (eq (current-column) 1) (eq (preceding-char) ?\>)) (forward-char -1) ; skip back > (skip-chars-backward " \t\n" start)))) ;; specific functions for literate code (defun haskell-indent-within-literate-code () "Check if point is within a part of literate Haskell code. If so, return its start; otherwise return nil: If it is Bird-style, then return the position of the >; otherwise return the ending position of \\begin{code}." (save-excursion (cl-case haskell-literate (bird (beginning-of-line) (if (or (eq (following-char) ?\>) (and (bolp) (forward-line -1) (eq (following-char) ?\>))) (progn (while (and (zerop (forward-line -1)) (eq (following-char) ?\>))) (if (not (eq (following-char) ?\>)) (forward-line)) (point)))) ;; Look for a \begin{code} or \end{code} line. ((latex tex) (if (re-search-backward "^\\(\\\\begin{code}$\\)\\|\\(\\\\end{code}$\\)" nil t) ;; within a literate code part if it was a \\begin{code}. (match-end 1))) (t (error "haskell-indent-within-literate-code: should not happen!"))))) (defun haskell-indent-put-region-in-literate (beg end &optional arg) "Put lines of the region as a piece of literate code. With prefix arg, remove indication that the region is literate code. It deals with both Bird style and non Bird-style scripts." (interactive "r\nP") (unless haskell-literate (error "Cannot put a region in literate in a non literate script")) (if (eq haskell-literate 'bird) (let ((comment-start "> ") ; Change dynamic bindings for (comment-start-skip "^> ?") ; comment-region. (comment-end "") (comment-end-skip "\n") (comment-style 'plain)) (comment-region beg end arg)) ;; Not Bird style. (if arg ; Remove the literate indication. (save-excursion (goto-char end) ; Remove end. (if (re-search-backward "^\\\\end{code}[ \t\n]*\\=" (line-beginning-position -2) t) (delete-region (point) (line-beginning-position 2))) (goto-char beg) ; Remove end. (beginning-of-line) (if (looking-at "\\\\begin{code}") (kill-line 1))) (save-excursion ; Add the literate indication. (goto-char end) (unless (bolp) (newline)) (insert "\\end{code}\n") (goto-char beg) (unless (bolp) (newline)) (insert "\\begin{code}\n"))))) ;;; Start of indentation code (defcustom haskell-indent-look-past-empty-line t "If nil, indentation engine will not look past an empty line for layout points." :group 'haskell-indent :safe #'booleanp :type 'boolean) (defun haskell-indent-start-of-def () "Return the position of the start of a definition. The start of a def is expected to be recognizable by starting in column 0, unless `haskell-indent-look-past-empty-line' is nil, in which case we take a coarser approximation and stop at the first empty line." (save-excursion (let ((start-code (and haskell-literate (haskell-indent-within-literate-code))) (top-col (if (eq haskell-literate 'bird) 2 0)) (save-point (point))) ;; determine the starting point of the current piece of code (setq start-code (if start-code (1+ start-code) (point-min))) ;; go backward until the first preceding empty line (haskell-indent-forward-line -1) (while (and (if haskell-indent-look-past-empty-line (or (> (haskell-indent-current-indentation) top-col) (haskell-indent-empty-line-p)) (and (> (haskell-indent-current-indentation) top-col) (not (haskell-indent-empty-line-p)))) (> (point) start-code) (= 0 (haskell-indent-forward-line -1)))) ;; go forward after the empty line (if (haskell-indent-empty-line-p) (haskell-indent-forward-line 1)) (setq start-code (point)) ;; find the first line of code which is not a comment (forward-comment (point-max)) (if (> (point) save-point) start-code (point))))) (defun haskell-indent-open-structure (start end) "If any structure (list or tuple) is not closed, between START and END, returns the location of the opening symbol, nil otherwise." (save-excursion (nth 1 (parse-partial-sexp start end)))) (defun haskell-indent-in-string (start end) "If a string is not closed , between START and END, returns the location of the opening symbol, nil otherwise." (save-excursion (let ((pps (parse-partial-sexp start end))) (if (nth 3 pps) (nth 8 pps))))) (defun haskell-indent-in-comment (start end) "Check, starting from START, if END is at or within a comment. Returns the location of the start of the comment, nil otherwise." (let (pps) (cl-assert (<= start end)) (cond ((= start end) nil) ((nth 4 (save-excursion (setq pps (parse-partial-sexp start end)))) (nth 8 pps)) ;; We also want to say that we are *at* the beginning of a comment. ((and (not (nth 8 pps)) (>= (point-max) (+ end 2)) (nth 4 (save-excursion (setq pps (parse-partial-sexp end (+ end 2)))))) (nth 8 pps))))) (defvar haskell-indent-off-side-keywords-re "\\<\\(do\\|let\\|of\\|where\\|mdo\\|rec\\)\\>[ \t]*") (defun haskell-indent-type-at-point () "Return the type of the line (also puts information in `match-data')." (cond ((haskell-indent-empty-line-p) 'empty) ((haskell-indent-in-comment (point-min) (point)) 'comment) ((looking-at "\\(\\([[:alpha:]]\\(\\sw\\|'\\)*\\)\\|_\\)[ \t\n]*") 'ident) ((looking-at "\\(|[^|]\\)[ \t\n]*") 'guard) ((looking-at "\\(=[^>=]\\|::\\|∷\\|→\\|←\\|->\\|<-\\)[ \t\n]*") 'rhs) (t 'other))) (defvar haskell-indent-current-line-first-ident "" "Global variable that keeps track of the first ident of the line to indent.") (defun haskell-indent-contour-line (start end) "Generate contour information between START and END points." (if (< start end) (save-excursion (goto-char end) (haskell-indent-skip-blanks-and-newlines-backward start) (let ((cur-col (current-column)) ; maximum column number (fl 0) ; number of lines that forward-line could not advance contour) (while (and (> cur-col 0) (= fl 0) (>= (point) start)) (haskell-indent-back-to-indentation) (if (< (point) start) (goto-char start)) (and (not (member (haskell-indent-type-at-point) '(empty comment))) ; skip empty and comment lines (< (current-column) cur-col) ; less indented column found (push (point) contour) ; new contour point found (setq cur-col (current-column))) (setq fl (haskell-indent-forward-line -1))) contour)))) (defun haskell-indent-next-symbol (end) "Move point to the next symbol." (skip-syntax-forward ")" end) (if (< (point) end) (progn (forward-sexp 1) (haskell-indent-skip-blanks-and-newlines-forward end)))) (defun haskell-indent-next-symbol-safe (end) "Puts point to the next following symbol, or to end if there are no more symbols in the sexp." (condition-case errlist (haskell-indent-next-symbol end) (error (goto-char end)))) (defun haskell-indent-separate-valdef (start end) "Return a list of positions for important parts of a valdef." (save-excursion (let (valname valname-string aft-valname guard aft-guard rhs-sign aft-rhs-sign type) ;; "parse" a valdef separating important parts (goto-char start) (setq type (haskell-indent-type-at-point)) (if (or (memq type '(ident other))) ; possible start of a value def (progn (if (eq type 'ident) (progn (setq valname (match-beginning 0)) (setq valname-string (match-string 0)) (goto-char (match-end 0))) (skip-chars-forward " \t" end) (setq valname (point)) ; type = other (haskell-indent-next-symbol-safe end)) (while (and (< (point) end) (setq type (haskell-indent-type-at-point)) (or (memq type '(ident other)))) (if (null aft-valname) (setq aft-valname (point))) (haskell-indent-next-symbol-safe end)))) (if (and (< (point) end) (eq type 'guard)) ; start of a guard (progn (setq guard (match-beginning 0)) (goto-char (match-end 0)) (while (and (< (point) end) (setq type (haskell-indent-type-at-point)) (not (eq type 'rhs))) (if (null aft-guard) (setq aft-guard (point))) (haskell-indent-next-symbol-safe end)))) (if (and (< (point) end) (eq type 'rhs)) ; start of a rhs (progn (setq rhs-sign (match-beginning 0)) (goto-char (match-end 0)) (if (< (point) end) (setq aft-rhs-sign (point))))) (list valname valname-string aft-valname guard aft-guard rhs-sign aft-rhs-sign)))) (defsubst haskell-indent-no-otherwise (guard) "Check if there is no otherwise at GUARD." (save-excursion (goto-char guard) (not (looking-at "|[ \t]*otherwise\\>")))) (defun haskell-indent-guard (start end end-visible indent-info) "Find indentation information for a line starting with a guard." (save-excursion (let* ((haskell-indent-info indent-info) (sep (haskell-indent-separate-valdef start end)) (valname (nth 0 sep)) (guard (nth 3 sep)) (rhs-sign (nth 5 sep))) ;; push information indentation for the visible part (if (and guard (< guard end-visible) (haskell-indent-no-otherwise guard)) (haskell-indent-push-pos guard) (if rhs-sign (haskell-indent-push-pos rhs-sign) ; probably within a data definition... (if valname (haskell-indent-push-pos-offset valname)))) haskell-indent-info))) (defun haskell-indent-rhs (start end end-visible indent-info) "Find indentation information for a line starting with a rhs." (save-excursion (let* ((haskell-indent-info indent-info) (sep (haskell-indent-separate-valdef start end)) (valname (nth 0 sep)) (guard (nth 3 sep)) (rhs-sign (nth 5 sep))) ;; push information indentation for the visible part (if (and rhs-sign (< rhs-sign end-visible)) (haskell-indent-push-pos rhs-sign) (if (and guard (< guard end-visible)) (haskell-indent-push-pos-offset guard) (if valname ; always visible !! (haskell-indent-push-pos-offset valname)))) haskell-indent-info))) (defconst haskell-indent-decision-table (let ((or "\\)\\|\\(")) (concat "\\(" "1.1.11" or ; 1= vn gd rh arh "1.1.10" or ; 2= vn gd rh "1.1100" or ; 3= vn gd agd "1.1000" or ; 4= vn gd "1.0011" or ; 5= vn rh arh "1.0010" or ; 6= vn rh "110000" or ; 7= vn avn "100000" or ; 8= vn "001.11" or ; 9= gd rh arh "001.10" or ;10= gd rh "001100" or ;11= gd agd "001000" or ;12= gd "000011" or ;13= rh arh "000010" or ;14= rh "000000" ;15= "\\)"))) (defun haskell-indent-find-case (test) "Find the index that matches TEST in the decision table." (if (string-match haskell-indent-decision-table test) ;; use the fact that the resulting match-data is a list of the form ;; (0 6 [2*(n-1) nil] 0 6) where n is the number of the matching regexp ;; so n= ((length match-data)/2)-1 (- (/ (length (match-data 'integers)) 2) 1) (error "haskell-indent-find-case: impossible case: %s" test))) (defun haskell-indent-empty (start end end-visible indent-info) "Find indentation points for an empty line." (save-excursion (let* ((haskell-indent-info indent-info) (sep (haskell-indent-separate-valdef start end)) (valname (pop sep)) (valname-string (pop sep)) (aft-valname (pop sep)) (guard (pop sep)) (aft-guard (pop sep)) (rhs-sign (pop sep)) (aft-rhs-sign (pop sep)) (last-line (= end end-visible)) (test (string (if valname ?1 ?0) (if (and aft-valname (< aft-valname end-visible)) ?1 ?0) (if (and guard (< guard end-visible)) ?1 ?0) (if (and aft-guard (< aft-guard end-visible)) ?1 ?0) (if (and rhs-sign (< rhs-sign end-visible)) ?1 ?0) (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) ?1 ?0)))) (if (and valname-string ; special case for start keywords (string-match haskell-indent-start-keywords-re valname-string)) (progn (haskell-indent-push-pos valname) ;; very special for data keyword (if (string-match "\\" valname-string) (if rhs-sign (haskell-indent-push-pos rhs-sign) (haskell-indent-push-pos-offset valname)) (haskell-indent-push-pos-offset valname))) (cl-case ; general case (haskell-indent-find-case test) ;; "1.1.11" 1= vn gd rh arh (1 (haskell-indent-push-pos valname) (haskell-indent-push-pos valname valname-string) (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| ")) (haskell-indent-push-pos aft-rhs-sign)) ;; "1.1.10" 2= vn gd rh (2 (haskell-indent-push-pos valname) (haskell-indent-push-pos valname valname-string) (if last-line (haskell-indent-push-pos-offset guard) (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| ")))) ;; "1.1100" 3= vn gd agd (3 (haskell-indent-push-pos valname) (haskell-indent-push-pos aft-guard) (if last-line (haskell-indent-push-pos-offset valname))) ;; "1.1000" 4= vn gd (4 (haskell-indent-push-pos valname) (if last-line (haskell-indent-push-pos-offset guard 2))) ;; "1.0011" 5= vn rh arh (5 (haskell-indent-push-pos valname) (if (or (and aft-valname (= (char-after rhs-sign) ?\=)) (= (char-after rhs-sign) ?\:)) (haskell-indent-push-pos valname valname-string)) (haskell-indent-push-pos aft-rhs-sign)) ;; "1.0010" 6= vn rh (6 (haskell-indent-push-pos valname) (haskell-indent-push-pos valname valname-string) (if last-line (haskell-indent-push-pos-offset valname))) ;; "110000" 7= vn avn (7 (haskell-indent-push-pos valname) (if last-line (haskell-indent-push-pos aft-valname) (haskell-indent-push-pos valname valname-string))) ;; "100000" 8= vn (8 (haskell-indent-push-pos valname)) ;; "001.11" 9= gd rh arh (9 (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| ")) (haskell-indent-push-pos aft-rhs-sign)) ;; "001.10" 10= gd rh (10 (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| ")) (if last-line (haskell-indent-push-pos-offset guard))) ;; "001100" 11= gd agd (11 (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| ")) (haskell-indent-push-pos aft-guard)) ;; "001000" 12= gd (12 (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos guard "| ")) (if last-line (haskell-indent-push-pos-offset guard 2))) ;; "000011" 13= rh arh (13 (haskell-indent-push-pos aft-rhs-sign)) ;; "000010" 14= rh (14 (if last-line (haskell-indent-push-pos-offset rhs-sign 2 ))) ;; "000000" 15= (t (error "haskell-indent-empty: %s impossible case" test )))) haskell-indent-info))) (defun haskell-indent-ident (start end end-visible indent-info) "Find indentation points for a line starting with an identifier." (save-excursion (let* ((haskell-indent-info indent-info) (sep (haskell-indent-separate-valdef start end)) (valname (pop sep)) (valname-string (pop sep)) (aft-valname (pop sep)) (guard (pop sep)) (aft-guard (pop sep)) (rhs-sign (pop sep)) (aft-rhs-sign (pop sep)) (last-line (= end end-visible)) (is-where (string-match "where[ \t]*" haskell-indent-current-line-first-ident)) (diff-first ; not a function def with the same name (or (null valname-string) (not (string= (haskell-string-trim valname-string) (haskell-string-trim haskell-indent-current-line-first-ident))))) ;; (is-type-def ;; (and rhs-sign (eq (char-after rhs-sign) ?\:))) (test (string (if valname ?1 ?0) (if (and aft-valname (< aft-valname end-visible)) ?1 ?0) (if (and guard (< guard end-visible)) ?1 ?0) (if (and aft-guard (< aft-guard end-visible)) ?1 ?0) (if (and rhs-sign (< rhs-sign end-visible)) ?1 ?0) (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) ?1 ?0)))) (if (and valname-string ; special case for start keywords (string-match haskell-indent-start-keywords-re valname-string)) (progn (haskell-indent-push-pos valname) (if (string-match "\\" valname-string) ;; very special for data keyword (if aft-rhs-sign (haskell-indent-push-pos aft-rhs-sign) (haskell-indent-push-pos-offset valname)) (if (not (string-match haskell-indent-start-keywords-re haskell-indent-current-line-first-ident)) (haskell-indent-push-pos-offset valname)))) (if (string= haskell-indent-current-line-first-ident "::") (if valname (haskell-indent-push-pos valname)) (cl-case ; general case (haskell-indent-find-case test) ;; "1.1.11" 1= vn gd rh arh (1 (if is-where (haskell-indent-push-pos guard) (haskell-indent-push-pos valname) (if diff-first (haskell-indent-push-pos aft-rhs-sign)))) ;; "1.1.10" 2= vn gd rh (2 (if is-where (haskell-indent-push-pos guard) (haskell-indent-push-pos valname) (if last-line (haskell-indent-push-pos-offset guard)))) ;; "1.1100" 3= vn gd agd (3 (if is-where (haskell-indent-push-pos-offset guard) (haskell-indent-push-pos valname) (if diff-first (haskell-indent-push-pos aft-guard)))) ;; "1.1000" 4= vn gd (4 (if is-where (haskell-indent-push-pos guard) (haskell-indent-push-pos valname) (if last-line (haskell-indent-push-pos-offset guard 2)))) ;; "1.0011" 5= vn rh arh (5 (if is-where (haskell-indent-push-pos-offset valname) (haskell-indent-push-pos valname) (if diff-first (haskell-indent-push-pos aft-rhs-sign)))) ;; "1.0010" 6= vn rh (6 (if is-where (haskell-indent-push-pos-offset valname) (haskell-indent-push-pos valname) (if last-line (haskell-indent-push-pos-offset valname)))) ;; "110000" 7= vn avn (7 (if is-where (haskell-indent-push-pos-offset valname) (haskell-indent-push-pos valname) (if last-line (haskell-indent-push-pos aft-valname)))) ;; "100000" 8= vn (8 (if is-where (haskell-indent-push-pos-offset valname) (haskell-indent-push-pos valname))) ;; "001.11" 9= gd rh arh (9 (if is-where (haskell-indent-push-pos guard) (haskell-indent-push-pos aft-rhs-sign))) ;; "001.10" 10= gd rh (10 (if is-where (haskell-indent-push-pos guard) (if last-line (haskell-indent-push-pos-offset guard)))) ;; "001100" 11= gd agd (11 (if is-where (haskell-indent-push-pos guard) (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos aft-guard)))) ;; "001000" 12= gd (12 (if last-line (haskell-indent-push-pos-offset guard 2))) ;; "000011" 13= rh arh (13 (haskell-indent-push-pos aft-rhs-sign)) ;; "000010" 14= rh (14 (if last-line (haskell-indent-push-pos-offset rhs-sign 2))) ;; "000000" 15= (t (error "haskell-indent-ident: %s impossible case" test ))))) haskell-indent-info))) (defun haskell-indent-other (start end end-visible indent-info) "Find indentation points for a non-empty line starting with something other than an identifier, a guard or rhs." (save-excursion (let* ((haskell-indent-info indent-info) (sep (haskell-indent-separate-valdef start end)) (valname (pop sep)) (valname-string (pop sep)) (aft-valname (pop sep)) (guard (pop sep)) (aft-guard (pop sep)) (rhs-sign (pop sep)) (aft-rhs-sign (pop sep)) (last-line (= end end-visible)) (test (string (if valname ?1 ?0) (if (and aft-valname (< aft-valname end-visible)) ?1 ?0) (if (and guard (< guard end-visible)) ?1 ?0) (if (and aft-guard (< aft-guard end-visible)) ?1 ?0) (if (and rhs-sign (< rhs-sign end-visible)) ?1 ?0) (if (and aft-rhs-sign (< aft-rhs-sign end-visible)) ?1 ?0)))) (if (and valname-string ; special case for start keywords (string-match haskell-indent-start-keywords-re valname-string)) (haskell-indent-push-pos-offset valname) (cl-case ; general case (haskell-indent-find-case test) ;; "1.1.11" 1= vn gd rh arh (1 (haskell-indent-push-pos aft-rhs-sign)) ;; "1.1.10" 2= vn gd rh (2 (if last-line (haskell-indent-push-pos-offset guard) (haskell-indent-push-pos-offset rhs-sign 2))) ;; "1.1100" 3= vn gd agd (3 (haskell-indent-push-pos aft-guard)) ;; "1.1000" 4= vn gd (4 (haskell-indent-push-pos-offset guard 2)) ;; "1.0011" 5= vn rh arh (5 (haskell-indent-push-pos valname) (haskell-indent-push-pos aft-rhs-sign)) ;; "1.0010" 6= vn rh (6 (if last-line (haskell-indent-push-pos-offset valname) (haskell-indent-push-pos-offset rhs-sign 2))) ;; "110000" 7= vn avn (7 (haskell-indent-push-pos-offset aft-valname)) ;; "100000" 8= vn (8 (haskell-indent-push-pos valname)) ;; "001.11" 9= gd rh arh (9 (haskell-indent-push-pos aft-rhs-sign)) ;; "001.10" 10= gd rh (10 (if last-line (haskell-indent-push-pos-offset guard) (haskell-indent-push-pos-offset rhs-sign 2))) ;; "001100" 11= gd agd (11 (if (haskell-indent-no-otherwise guard) (haskell-indent-push-pos aft-guard))) ;; "001000" 12= gd (12 (if last-line (haskell-indent-push-pos-offset guard 2))) ;; "000011" 13= rh arh (13 (haskell-indent-push-pos aft-rhs-sign)) ;; "000010" 14= rh (14 (if last-line (haskell-indent-push-pos-offset rhs-sign 2))) ;; "000000" 15= (t (error "haskell-indent-other: %s impossible case" test )))) haskell-indent-info))) (defun haskell-indent-valdef-indentation (start end end-visible curr-line-type indent-info) "Find indentation information for a value definition." (let ((haskell-indent-info indent-info)) (if (< start end-visible) (cl-case curr-line-type (empty (haskell-indent-empty start end end-visible indent-info)) (ident (haskell-indent-ident start end end-visible indent-info)) (guard (haskell-indent-guard start end end-visible indent-info)) (rhs (haskell-indent-rhs start end end-visible indent-info)) (comment (error "Comment indent should never happen")) (other (haskell-indent-other start end end-visible indent-info))) haskell-indent-info))) (defun haskell-indent-line-indentation (line-start line-end end-visible curr-line-type indent-info) "Compute indentation info between LINE-START and END-VISIBLE. Separate a line of program into valdefs between offside keywords and find indentation info for each part." (save-excursion ;; point is (already) at line-start (cl-assert (eq (point) line-start)) (let ((haskell-indent-info indent-info) (start (or (haskell-indent-in-comment line-start line-end) (haskell-indent-in-string line-start line-end)))) (if start ; if comment at the end (setq line-end start)) ; end line before it ;; loop on all parts separated by off-side-keywords (while (and (re-search-forward haskell-indent-off-side-keywords-re line-end t) (not (or (haskell-indent-in-comment line-start (point)) (haskell-indent-in-string line-start (point))))) (let ((beg-match (match-beginning 0)) ; save beginning of match (end-match (match-end 0))) ; save end of match ;; Do not try to find indentation points if off-side-keyword at ;; the start... (if (or (< line-start beg-match) ;; Actually, if we're looking at a "let" inside a "do", we ;; should add the corresponding indentation point. (eq (char-after beg-match) ?l)) (setq haskell-indent-info (haskell-indent-valdef-indentation line-start beg-match end-visible curr-line-type haskell-indent-info))) ;; ...but keep the start of the line if keyword alone on the line (if (= line-end end-match) (haskell-indent-push-pos beg-match)) (setq line-start end-match) (goto-char line-start))) (haskell-indent-valdef-indentation line-start line-end end-visible curr-line-type haskell-indent-info)))) (defun haskell-indent-layout-indent-info (start contour-line) (let ((haskell-indent-info nil) (curr-line-type (haskell-indent-type-at-point)) line-start line-end end-visible) (save-excursion (if (eq curr-line-type 'ident) (let ; guess the type of line ((sep (haskell-indent-separate-valdef (point) (line-end-position)))) ;; if the first ident is where or the start of a def ;; keep it in a global variable (setq haskell-indent-current-line-first-ident (if (string-match "where[ \t]*" (nth 1 sep)) (nth 1 sep) (if (nth 5 sep) ; is there a rhs-sign (if (= (char-after (nth 5 sep)) ?\:) ;is it a typdef "::" (nth 1 sep)) ""))))) (while contour-line ; explore the contour points (setq line-start (pop contour-line)) (goto-char line-start) (setq line-end (line-end-position)) (setq end-visible ; visible until the column of the (if contour-line ; next contour point (save-excursion (move-to-column (haskell-indent-point-to-col (car contour-line))) (point)) line-end)) (unless (or (haskell-indent-open-structure start line-start) (haskell-indent-in-comment start line-start)) (setq haskell-indent-info (haskell-indent-line-indentation line-start line-end end-visible curr-line-type haskell-indent-info))))) haskell-indent-info)) (defun haskell-indent-find-matching-start (regexp limit &optional pred start) (let ((open (haskell-indent-open-structure limit (point)))) (if open (setq limit (1+ open)))) (unless start (setq start (point))) (when (re-search-backward regexp limit t) (let ((nestedcase (match-end 1)) (outer (or (haskell-indent-in-string limit (point)) (haskell-indent-in-comment limit (point)) (haskell-indent-open-structure limit (point)) (if (and pred (funcall pred start)) (point))))) (cond (outer (goto-char outer) (haskell-indent-find-matching-start regexp limit pred start)) (nestedcase ;; Nested case. (and (haskell-indent-find-matching-start regexp limit pred) (haskell-indent-find-matching-start regexp limit pred start))) (t (point)))))) (defun haskell-indent-filter-let-no-in (start) "Return non-nil if point is in front of a `let' that has no `in'. START is the position of the presumed `in'." ;; We're looking at either `in' or `let'. (when (looking-at "let") (ignore-errors (save-excursion (forward-word 1) (forward-comment (point-max)) (if (looking-at "{") (progn (forward-sexp 1) (forward-comment (point-max)) (< (point) start)) ;; Use the layout rule to see whether this let is already closed ;; without an `in'. (let ((col (current-column))) (while (progn (forward-line 1) (haskell-indent-back-to-indentation) (< (point) start)) (when (< (current-column) col) (setq col nil) (goto-char start))) (null col))))))) (defun haskell-indent-comment (open start) "Compute indent info for comments and text inside comments. OPEN is the start position of the comment in which point is." ;; Ideally we'd want to guess whether it's commented out code or ;; whether it's text. Instead, we'll assume it's text. (save-excursion (if (= open (point)) ;; We're actually just in front of a comment: align with following ;; code or with comment on previous line. (let ((prev-line-info (cond ((eq (char-after) ?\{) nil) ;Align as if it were code. ((and (forward-comment -1) (> (line-beginning-position 3) open)) ;; We're after another comment and there's no empty line ;; between us. (list (list (haskell-indent-point-to-col (point))))) (t nil)))) ;Else align as if it were code ;; Align with following code. (forward-comment (point-max)) ;; There are several possible indentation points for this code-line, ;; but the only valid indentation point for the comment is the one ;; that the user will select for the code-line. Obviously we can't ;; know that, so we just assume that the code-line is already at its ;; proper place. ;; Strictly speaking "assume it's at its proper place" would mean ;; we'd just use (current-column), but since this is using info from ;; lines further down and it's common to reindent line-by-line, ;; we'll align not with the current indentation, but with the ;; one that auto-indentation "will" select. (append prev-line-info (let ((indent-info (save-excursion (haskell-indent-indentation-info start))) (col (current-column))) ;; Sort the indent-info so that the current indentation comes ;; out first. (setq indent-info (sort indent-info (lambda (x y) (<= (abs (- col (car x))) (abs (- col (car y))))))) indent-info))) ;; We really are inside a comment. (if (looking-at "-}") (progn (forward-char 2) (forward-comment -1) (list (list (1+ (haskell-indent-point-to-col (point)))))) (let ((offset (if (looking-at "--?") (- (match-beginning 0) (match-end 0))))) (forward-line -1) ;Go to previous line. (haskell-indent-back-to-indentation) (if (< (point) start) (goto-char start)) (list (list (if (looking-at comment-start-skip) (if offset (+ 2 offset (haskell-indent-point-to-col (point))) (haskell-indent-point-to-col (match-end 0))) (haskell-indent-point-to-col (point)))))))))) (defcustom haskell-indent-thenelse 0 "If non-nil, \"then\" and \"else\" are indented. This is necessary in the \"do\" layout under Haskell-98. See http://hackage.haskell.org/trac/haskell-prime/wiki/DoAndIfThenElse" :group 'haskell-indent :safe #'booleanp :type 'integer) (defun haskell-indent-closing-keyword (start) (let ((open (save-excursion (haskell-indent-find-matching-start (cl-case (char-after) (?i "\\<\\(?:\\(in\\)\\|let\\)\\>") (?o "\\<\\(?:\\(of\\)\\|case\\)\\>") (?t "\\<\\(?:\\(then\\)\\|if\\)\\>") (?e "\\<\\(?:\\(else\\)\\|if\\)\\>")) start (if (eq (char-after) ?i) ;; Filter out the `let's that have no `in'. 'haskell-indent-filter-let-no-in))))) ;; For a "hanging let/case/if at EOL" we should use a different ;; indentation scheme. (save-excursion (goto-char open) (if (haskell-indent-hanging-p) (setq open (haskell-indent-virtual-indentation start)))) ;; FIXME: we should try and figure out if the `if' is in a `do' layout ;; before using haskell-indent-thenelse. (list (list (+ (if (memq (char-after) '(?t ?e)) haskell-indent-thenelse 0) (haskell-indent-point-to-col open)))))) (defcustom haskell-indent-after-keywords '(("where" 2 0) ("of" 2) ("do" 2) ("mdo" 2) ("rec" 2) ("in" 2 0) ("{" 2) "if" "then" "else" "let") "Keywords after which indentation should be indented by some offset. Each keyword info can have the following forms: KEYWORD | (KEYWORD OFFSET [OFFSET-HANGING]) If absent OFFSET-HANGING defaults to OFFSET. If absent OFFSET defaults to `haskell-indent-offset'. OFFSET-HANGING is the offset to use in the case where the keyword is at the end of an otherwise-non-empty line." :group 'haskell-indent :type '(repeat (choice string (cons :tag "" (string :tag "keyword:") (cons :tag "" (integer :tag "offset") (choice (const nil) (list :tag "" (integer :tag "offset-pending")))))))) (defun haskell-indent-skip-lexeme-forward () (and (zerop (skip-syntax-forward "w")) (skip-syntax-forward "_") (skip-syntax-forward "(") (skip-syntax-forward ")"))) (defvar haskell-indent-inhibit-after-offset nil) (defun haskell-indent-offset-after-info () "Return the info from `haskell-indent-after-keywords' for keyword at point." (let ((id (buffer-substring (point) (save-excursion (haskell-indent-skip-lexeme-forward) (point))))) (or (assoc id haskell-indent-after-keywords) (car (member id haskell-indent-after-keywords))))) (defcustom haskell-indent-dont-hang '("(") "Lexemes that should never be considered as hanging." :group 'haskell-indent :type '(repeat string)) (defun haskell-indent-hanging-p () ;; A Hanging keyword is one that's at the end of a line except it's not at ;; the beginning of a line. (not (or (= (current-column) (haskell-indent-current-indentation)) (save-excursion (let ((lexeme (buffer-substring (point) (progn (haskell-indent-skip-lexeme-forward) (point))))) (or (member lexeme haskell-indent-dont-hang) (> (line-end-position) (progn (forward-comment (point-max)) (point))))))))) (defun haskell-indent-after-keyword-column (offset-info start &optional default) (unless offset-info (setq offset-info (haskell-indent-offset-after-info))) (unless default (setq default haskell-indent-offset)) (setq offset-info (if haskell-indent-inhibit-after-offset '(0) (cdr-safe offset-info))) (if (not (haskell-indent-hanging-p)) (haskell-indent-column+offset (current-column) (or (car offset-info) default)) ;; The keyword is hanging at the end of the line. (haskell-indent-column+offset (haskell-indent-virtual-indentation start) (or (cadr offset-info) (car offset-info) default)))) (defun haskell-indent-inside-paren (open) ;; there is an open structure to complete (if (looking-at "\\s)\\|[;,]") ;; A close-paren or a , or ; can only correspond syntactically to ;; the open-paren at `open'. So there is no ambiguity. (progn (if (or (and (eq (char-after) ?\;) (eq (char-after open) ?\()) (and (eq (char-after) ?\,) (eq (char-after open) ?\{))) (message "Mismatched punctuation: `%c' in %c...%c" (char-after) (char-after open) (if (eq (char-after open) ?\() ?\) ?\}))) (save-excursion (goto-char open) (list (list (if (haskell-indent-hanging-p) (haskell-indent-virtual-indentation nil) (haskell-indent-point-to-col open)))))) ;; There might still be layout within the open structure. (let* ((end (point)) (basic-indent-info ;; Anything else than a ) is subject to layout. (if (looking-at "\\s.\\|\\$ ") (haskell-indent-point-to-col open) ; align a punct with ( (let ((follow (save-excursion (goto-char (1+ open)) (haskell-indent-skip-blanks-and-newlines-forward end) (point)))) (if (= follow end) (save-excursion (goto-char open) (haskell-indent-after-keyword-column nil nil 1)) (haskell-indent-point-to-col follow))))) (open-column (haskell-indent-point-to-col open)) (contour-line (haskell-indent-contour-line (1+ open) end))) (if (null contour-line) (list (list basic-indent-info)) (let ((indent-info (haskell-indent-layout-indent-info (1+ open) contour-line))) ;; Fix up indent info. (let ((base-elem (assoc open-column indent-info))) (if base-elem (progn (setcar base-elem basic-indent-info) (setcdr base-elem nil)) (setq indent-info (append indent-info (list (list basic-indent-info))))) indent-info)))))) (defun haskell-indent-virtual-indentation (start) "Compute the \"virtual indentation\" of text at point. The \"virtual indentation\" is the indentation that text at point would have had, if it had been placed on its own line." (let ((col (current-column)) (haskell-indent-inhibit-after-offset (haskell-indent-hanging-p))) (if (save-excursion (skip-chars-backward " \t") (bolp)) ;; If the text is indeed on its own line, than the virtual indent is ;; the current indentation. col ;; Else, compute the indentation that it would have had. (let ((info (haskell-indent-indentation-info start)) (max -1)) ;; `info' is a list of possible indent points. Each indent point is ;; assumed to correspond to a different parse. So we need to find ;; the parse that corresponds to the case at hand (where there's no ;; line break), which is assumed to always be the ;; deepest indentation. (dolist (x info) (setq x (car x)) ;; Sometimes `info' includes the current indentation (or yet ;; deeper) by mistake, because haskell-indent-indentation-info ;; wasn't designed to be called on a piece of text that is not at ;; BOL. So ignore points past `col'. (if (and (> x max) (not (>= x col))) (setq max x))) ;; In case all the indent points are past `col', just use `col'. (if (>= max 0) max col))))) (defun haskell-indent-indentation-info (&optional start) "Return a list of possible indentations for the current line. These are then used by `haskell-indent-cycle'. START if non-nil is a presumed start pos of the current definition." (unless start (setq start (haskell-indent-start-of-def))) (let (open contour-line) (cond ;; in string? ((setq open (haskell-indent-in-string start (point))) (list (list (+ (haskell-indent-point-to-col open) (if (looking-at "\\\\") 0 1))))) ;; in comment ? ((setq open (haskell-indent-in-comment start (point))) (haskell-indent-comment open start)) ;; Closing the declaration part of a `let' or the test exp part of a case. ((looking-at "\\(?:in\\|of\\|then\\|else\\)\\>") (haskell-indent-closing-keyword start)) ;; Right after a special keyword. ((save-excursion (forward-comment (- (point-max))) (when (and (not (zerop (skip-syntax-backward "w"))) (setq open (haskell-indent-offset-after-info))) (list (list (haskell-indent-after-keyword-column open start)))))) ;; open structure? ie ( { [ ((setq open (haskell-indent-open-structure start (point))) (haskell-indent-inside-paren open)) ;; full indentation ((setq contour-line (haskell-indent-contour-line start (point))) (haskell-indent-layout-indent-info start contour-line)) (t ;; simple contour just one indentation at start (list (list (if (and (eq haskell-literate 'bird) (eq (haskell-indent-point-to-col start) 1)) ;; for a Bird style literate script put default offset ;; in the case of no indentation (1+ haskell-indent-literate-Bird-default-offset) (haskell-indent-point-to-col start)))))))) (defvar haskell-indent-last-info nil) (defun haskell-indent-cycle () "Indentation cycle. We stay in the cycle as long as the TAB key is pressed." (interactive "*") (if (and haskell-literate (not (haskell-indent-within-literate-code))) ;; use the ordinary tab for text... (funcall (default-value 'indent-line-function)) (let ((marker (if (> (current-column) (haskell-indent-current-indentation)) (point-marker))) (bol (progn (beginning-of-line) (point)))) (haskell-indent-back-to-indentation) (unless (and (eq last-command this-command) (eq bol (car haskell-indent-last-info))) (save-excursion (setq haskell-indent-last-info (list bol (haskell-indent-indentation-info) 0 0)))) (let* ((il (nth 1 haskell-indent-last-info)) (index (nth 2 haskell-indent-last-info)) (last-insert-length (nth 3 haskell-indent-last-info)) (indent-info (nth index il))) (haskell-indent-line-to (car indent-info)) ; insert indentation (delete-char last-insert-length) (setq last-insert-length 0) (let ((text (cdr indent-info))) (if text (progn (insert text) (setq last-insert-length (length text))))) (setq haskell-indent-last-info (list bol il (% (1+ index) (length il)) last-insert-length)) (if (= (length il) 1) (message "Sole indentation") (message "Indent cycle (%d)..." (length il))) (if marker (goto-char (marker-position marker))))))) (defun haskell-indent-region (start end) (error "Auto-reindentation of a region is not supported")) ;;; alignment functions (defun haskell-indent-shift-columns (dest-column region-stack) "Shift columns in REGION-STACK to go to DEST-COLUMN. Elements of the stack are pairs of points giving the start and end of the regions to move." (let (reg col diffcol reg-end) (while (setq reg (pop region-stack)) (setq reg-end (copy-marker (cdr reg))) (goto-char (car reg)) (setq col (current-column)) (setq diffcol (- dest-column col)) (if (not (zerop diffcol)) (catch 'end-of-buffer (while (<= (point) (marker-position reg-end)) (if (< diffcol 0) (backward-delete-char-untabify (- diffcol) nil) (insert-char ?\ diffcol)) (end-of-line 2) ; should be (forward-line 1) (if (eobp) ; but it adds line at the end... (throw 'end-of-buffer nil)) (move-to-column col))))))) (defun haskell-indent-align-def (p-arg type) "Align guards or rhs within the current definition before point. If P-ARG is t align all defs up to the mark. TYPE is either 'guard or 'rhs." (save-excursion (let (start-block end-block (maxcol (if (eq type 'rhs) haskell-indent-rhs-align-column 0)) contour sep defname defnamepos defcol pos lastpos regstack eqns-start start-found) ;; find the starting and ending boundary points for alignment (if p-arg (if (mark) ; aligning everything in the region (progn (when (> (mark) (point)) (exchange-point-and-mark)) (setq start-block (save-excursion (goto-char (mark)) (line-beginning-position))) (setq end-block (progn (if (haskell-indent-bolp) (haskell-indent-forward-line -1)) (line-end-position)))) (error "The mark is not set for aligning definitions")) ;; aligning the current definition (setq start-block (haskell-indent-start-of-def)) (setq end-block (line-end-position))) ;; find the start of the current valdef using the contour line ;; in reverse order because we need the nearest one from the end (setq contour (reverse (haskell-indent-contour-line start-block end-block))) (setq pos (car contour)) ; keep the start of the first contour ;; find the nearest start of a definition (while (and (not defname) contour) (goto-char (pop contour)) (if (haskell-indent-open-structure start-block (point)) nil (setq sep (haskell-indent-separate-valdef (point) end-block)) (if (nth 5 sep) ; is there a rhs? (progn (setq defnamepos (nth 0 sep)) (setq defname (nth 1 sep)))))) ;; start building the region stack (if defnamepos (progn ; there is a valdef ;; find the start of each equation or guard (if p-arg ; when indenting a region ;; accept any start of id or pattern as def name (setq defname "\\<\\|(")) (setq defcol (haskell-indent-point-to-col defnamepos)) (goto-char pos) (setq end-block (line-end-position)) (catch 'top-of-buffer (while (and (not start-found) (>= (point) start-block)) (if (<= (haskell-indent-current-indentation) defcol) (progn (move-to-column defcol) (if (and (looking-at defname) ; start of equation (not (haskell-indent-open-structure start-block (point)))) (push (cons (point) 'eqn) eqns-start) ;; found a less indented point not starting an equation (setq start-found t))) ;; more indented line (haskell-indent-back-to-indentation) (if (and (eq (haskell-indent-type-at-point) 'guard) ; start of a guard (not (haskell-indent-open-structure start-block (point)))) (push (cons (point) 'gd) eqns-start))) (if (bobp) (throw 'top-of-buffer nil) (haskell-indent-backward-to-indentation 1)))) ;; remove the spurious guards before the first equation (while (and eqns-start (eq (cdar eqns-start) 'gd)) (pop eqns-start)) ;; go through each equation to find the region to indent (while eqns-start (let ((eqn (caar eqns-start))) (setq lastpos (if (cdr eqns-start) (save-excursion (goto-char (cl-caadr eqns-start)) (haskell-indent-forward-line -1) (line-end-position)) end-block)) (setq sep (haskell-indent-separate-valdef eqn lastpos))) (if (eq type 'guard) (setq pos (nth 3 sep)) ;; check if what follows a rhs sign is more indented or not (let ((rhs (nth 5 sep)) (aft-rhs (nth 6 sep))) (if (and rhs aft-rhs (> (haskell-indent-point-to-col rhs) (haskell-indent-point-to-col aft-rhs))) (setq pos aft-rhs) (setq pos rhs)))) (if pos (progn ; update region stack (push (cons pos (or lastpos pos)) regstack) (setq maxcol ; find the highest column number (max maxcol (progn ;find the previous non-empty column (goto-char pos) (skip-chars-backward " \t" (line-beginning-position)) (if (haskell-indent-bolp) ;;if on an empty prefix (haskell-indent-point-to-col pos) ;keep original indent (1+ (haskell-indent-point-to-col (point))))))))) (pop eqns-start)) ;; now shift according to the region stack (if regstack (haskell-indent-shift-columns maxcol regstack))))))) (defun haskell-indent-align-guards-and-rhs (start end) "Align the guards and rhs of functions in the region, which must be active." ;; The `start' and `end' args are dummys right now: they're just there so ;; we can use the "r" interactive spec which properly signals an error. (interactive "*r") (haskell-indent-align-def t 'guard) (haskell-indent-align-def t 'rhs)) ;;; insertion functions (defun haskell-indent-insert-equal () "Insert an = sign and align the previous rhs of the current function." (interactive "*") (if (or (haskell-indent-bolp) (/= (preceding-char) ?\ )) (insert ?\ )) (insert "= ") (haskell-indent-align-def (haskell-indent-mark-active) 'rhs)) (defun haskell-indent-insert-guard (&optional text) "Insert and align a guard sign (|) followed by optional TEXT. Alignment works only if all guards are to the south-east of their |." (interactive "*") (let ((pc (if (haskell-indent-bolp) ?\012 (preceding-char))) (pc1 (or (char-after (- (point) 2)) 0))) ;; check what guard to insert depending on the previous context (if (= pc ?\ ) ; x = any char other than blank or | (if (/= pc1 ?\|) (insert "| ") ; after " x" ()) ; after " |" (if (= pc ?\|) (if (= pc1 ?\|) (insert " | ") ; after "||" (insert " ")) ; after "x|" (insert " | "))) ; general case (if text (insert text)) (haskell-indent-align-def (haskell-indent-mark-active) 'guard))) (defun haskell-indent-insert-otherwise () "Insert a guard sign (|) followed by `otherwise'. Also align the previous guards of the current function." (interactive "*") (haskell-indent-insert-guard "otherwise") (haskell-indent-insert-equal)) (defun haskell-indent-insert-where () "Insert a where keyword at point and indent resulting line. One indentation cycle is used." (interactive "*") (insert "where ") (haskell-indent-cycle)) ;;; haskell-indent-mode (defvar haskell-indent-mode nil "Non-nil if the semi-intelligent Haskell indentation mode is in effect.") (make-variable-buffer-local 'haskell-indent-mode) (defvar haskell-indent-map (let ((map (make-sparse-keymap))) ;; Removed: remapping DEL seems a bit naughty --SDM ;; (define-key map "\177" 'backward-delete-char-untabify) ;; The binding to TAB is already handled by indent-line-function. --Stef ;; (define-key map "\t" 'haskell-indent-cycle) (define-key map [?\C-c ?\C-=] 'haskell-indent-insert-equal) (define-key map [?\C-c ?\C-|] 'haskell-indent-insert-guard) ;; Alternate binding, in case C-c C-| is too inconvenient to type. ;; Duh, C-g is a special key, let's not use it here. ;; (define-key map [?\C-c ?\C-g] 'haskell-indent-insert-guard) (define-key map [?\C-c ?\C-o] 'haskell-indent-insert-otherwise) (define-key map [?\C-c ?\C-w] 'haskell-indent-insert-where) (define-key map [?\C-c ?\C-.] 'haskell-indent-align-guards-and-rhs) (define-key map [?\C-c ?\C->] 'haskell-indent-put-region-in-literate) map)) ;;;###autoload (defun turn-on-haskell-indent () "Turn on ``intelligent'' Haskell indentation mode." (set (make-local-variable 'indent-line-function) 'haskell-indent-cycle) (set (make-local-variable 'indent-region-function) 'haskell-indent-region) (setq haskell-indent-mode t) ;; Activate our keymap. (let ((map (current-local-map))) (while (and map (not (eq map haskell-indent-map))) (setq map (keymap-parent map))) (if map ;; haskell-indent-map is already active: nothing to do. nil ;; Put our keymap on top of the others. We could also put it in ;; second place, or in a minor-mode. The minor-mode approach would be ;; easier, but it's harder for the user to override it. This approach ;; is the closest in behavior compared to the previous code that just ;; used a bunch of local-set-key. (set-keymap-parent haskell-indent-map (current-local-map)) ;; Protect our keymap. (setq map (make-sparse-keymap)) (set-keymap-parent map haskell-indent-map) (use-local-map map))) (run-hooks 'haskell-indent-hook)) (defun turn-off-haskell-indent () "Turn off ``intelligent'' Haskell indentation mode." (kill-local-variable 'indent-line-function) (kill-local-variable 'indent-region-function) ;; Remove haskell-indent-map from the local map. (let ((map (current-local-map))) (while map (let ((parent (keymap-parent map))) (if (eq haskell-indent-map parent) (set-keymap-parent map (keymap-parent parent)) (setq map parent))))) (setq haskell-indent-mode nil)) ;; Put this minor mode on the global minor-mode-alist. (or (assq 'haskell-indent-mode (default-value 'minor-mode-alist)) (setq-default minor-mode-alist (append (default-value 'minor-mode-alist) '((haskell-indent-mode " Ind"))))) ;;;###autoload (defun haskell-indent-mode (&optional arg) "``Intelligent'' Haskell indentation mode. This deals with the layout rule of Haskell. \\[haskell-indent-cycle] starts the cycle which proposes new possibilities as long as the TAB key is pressed. Any other key or mouse click terminates the cycle and is interpreted except for RET which merely exits the cycle. Other special keys are: \\[haskell-indent-insert-equal] inserts an = \\[haskell-indent-insert-guard] inserts an | \\[haskell-indent-insert-otherwise] inserts an | otherwise = these functions also align the guards and rhs of the current definition \\[haskell-indent-insert-where] inserts a where keyword \\[haskell-indent-align-guards-and-rhs] aligns the guards and rhs of the region \\[haskell-indent-put-region-in-literate] makes the region a piece of literate code in a literate script Invokes `haskell-indent-hook' if not nil." (interactive "P") (setq haskell-indent-mode (if (null arg) (not haskell-indent-mode) (> (prefix-numeric-value arg) 0))) (if haskell-indent-mode (turn-on-haskell-indent) (turn-off-haskell-indent))) (provide 'haskell-indent) ;;; haskell-indent.el ends here haskell-mode-13.14.2/haskell-indentation.el000066400000000000000000001457021253441665600205330ustar00rootroot00000000000000;;; haskell-indentation.el -- indentation module for Haskell Mode ;; Copyright (C) 2013 Kristof Bastiaensen, Gergely Risko ;; Author: Kristof Bastiaensen ;; Author: Gergely Risko ;; Keywords: indentation haskell ;; URL: https://github.com/haskell/haskell-mode ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; Installation: ;; ;; To turn indentation on for all Haskell buffers under Haskell mode ;; add this to .emacs: ;; ;; (add-hook haskell-mode-hook 'turn-on-haskell-indentation) ;; ;; Otherwise, call `haskell-indentation-mode'. ;;; Code: (require 'hl-line) (require 'syntax) (require 'cl-lib) (defvar haskell-indentation-dyn-first-position) (defvar haskell-indentation-dyn-last-direction) (defvar haskell-indentation-dyn-last-indentations) (defgroup haskell-indentation nil "Haskell indentation." :link '(custom-manual "(haskell-mode)Indentation") :group 'haskell :prefix "haskell-indentation-") (defcustom haskell-indentation-show-indentations nil "If t the current line's indentation points will be showed as underscore overlays in new haskell-mode buffers. Use `haskell-indentation-enable-show-indentations' and `haskell-indentation-disable-show-indentations' to switch the behavior for already existing buffers." :type 'boolean :group 'haskell-indentation) (defcustom haskell-indentation-show-indentations-after-eol nil "If t, try to show indentation points after the end of line. This requires strange overlay hacks and can collide with other modes (e.g. fill-column-indicator)." :type 'boolean :group 'haskell-indentation) (defface haskell-indentation-show-normal-face '((t :underline t)) "Default face for indentations overlay." :group 'haskell-indentation) (defface haskell-indentation-show-hl-line-face '((t :underline t :inherit hl-line)) "Face used for indentations overlay after EOL if hl-line mode is enabled." :group 'haskell-indentation) (defcustom haskell-indentation-indent-leftmost 'both "Indent to the left margin after certain keywords (for example after let .. in, case .. of). If set to t it will only indent to the left. If nil only relative to the containing expression. If set to the keyword 'both then both positions are allowed." :type 'symbol :group 'haskell-indentation) (defcustom haskell-indentation-layout-offset 2 "Extra indentation to add before expressions in a haskell layout list." :type 'integer :group 'haskell-indentation) (defcustom haskell-indentation-starter-offset 1 "Extra indentation after an opening keyword (e.g. let)." :type 'integer :group 'haskell-indentation) (defcustom haskell-indentation-left-offset 2 "Extra indentation after an indentation to the left (e.g. after do)." :type 'integer :group 'haskell-indentation) (defcustom haskell-indentation-ifte-offset 2 "Extra indentation after the keywords `if' `then' or `else'." :type 'integer :group 'haskell-indentation) (defcustom haskell-indentation-where-pre-offset 2 "Extra indentation before the keyword `where'." :type 'integer :group 'haskell-indentation) (defcustom haskell-indentation-where-post-offset 2 "Extra indentation after the keyword `where'." :type 'integer :group 'haskell-indentation) (defconst haskell-indentation-mode-map (let ((keymap (make-sparse-keymap))) (define-key keymap (kbd "RET") 'haskell-indentation-newline-and-indent) (define-key keymap (kbd "") 'haskell-indentation-indent-backwards) keymap)) ;;;###autoload (define-minor-mode haskell-indentation-mode "Haskell indentation mode that deals with the layout rule. It rebinds RET, DEL and BACKSPACE, so that indentations can be set and deleted as if they were real tabs. It supports autofill-mode. It is possible to render indent stops for current line as overlays. Please read documentation for option `haskell-indentation-enable-show-indentations' and option `haskell-indentation-show-indentations-after-eol'. These options were disabled by default because in most cases occurs overlay clashing with other modes." :lighter " Ind" :keymap haskell-indentation-mode-map (kill-local-variable 'indent-line-function) (kill-local-variable 'indent-region-function) (kill-local-variable 'normal-auto-fill-function) (when haskell-indentation-mode (setq max-lisp-eval-depth (max max-lisp-eval-depth 600)) ;; set a higher limit for recursion (set (make-local-variable 'indent-line-function) 'haskell-indentation-indent-line) (set (make-local-variable 'indent-region-function) 'haskell-indentation-indent-region) (set (make-local-variable 'normal-auto-fill-function) 'haskell-indentation-auto-fill-function) (when haskell-indentation-show-indentations (haskell-indentation-enable-show-indentations)))) ;;;###autoload (defun turn-on-haskell-indentation () "Turn on the haskell-indentation minor mode." (interactive) (haskell-indentation-mode t)) (put 'parse-error 'error-conditions '(error parse-error)) (put 'parse-error 'error-message "Parse error") (defun parse-error (&rest args) (signal 'parse-error (apply 'format args))) (defmacro on-parse-error (except &rest body) `(condition-case parse-error-string (progn ,@body) (parse-error ,except (message "%s" (cdr parse-error-string))))) (defvar haskell-literate) (defun haskell-indentation-birdp () "Return t if this is a literate haskell buffer in bird style, nil otherwise." (eq haskell-literate 'bird)) ;;---------------------------------------- UI starts here (defun haskell-indentation-auto-fill-function () (when (> (current-column) fill-column) (while (> (current-column) fill-column) (skip-syntax-backward "-") (skip-syntax-backward "^-")) (let ((indent (car (last (haskell-indentation-find-indentations-safe))))) (delete-horizontal-space) (newline) (when (haskell-indentation-birdp) (insert ">")) (indent-to indent) (end-of-line)))) (defun haskell-indentation-reindent-to (col &optional move) "Reindent current line to COL, also move the point there if MOVE" (let* ((cc (current-column)) (ci (haskell-indentation-current-indentation))) (save-excursion (move-to-column ci) (if (<= ci col) (insert-before-markers (make-string (- col ci) ? )) (delete-char (- col ci)))) (when move (move-to-column col)))) (defun haskell-indentation-indent-rigidly (start end arg) "Indent all lines starting in the region sideways by ARG columns. Called from a program, takes three arguments, START, END and ARG. You can remove all indentation from a region by giving a large negative ARG. Handles bird style literate haskell too." (interactive "r\np") (save-excursion (goto-char end) (let ((end-marker (point-marker))) (goto-char start) (or (bolp) (forward-line 0)) (while (< (point) end-marker) (let ((ci (haskell-indentation-current-indentation))) (when (and t (eq (char-after) ?>)) (forward-char 1)) (skip-syntax-forward "-") (unless (eolp) (haskell-indentation-reindent-to (max 0 (+ ci arg)))) (forward-line 1))) (move-marker end-marker nil)))) (defun haskell-indentation-current-indentation () "Column position of first non whitespace character in current line" (save-excursion (beginning-of-line) (when (haskell-indentation-birdp) (forward-char)) (skip-syntax-forward "-") (current-column))) (defun haskell-indentation-bird-outside-codep () "True iff we are in bird literate mode, but outside of code" (and (haskell-indentation-birdp) (or (< (current-column) 2) (save-excursion (beginning-of-line) (not (eq (char-after) ?>)))))) (defun haskell-indentation-delete-horizontal-space-and-newline () (delete-horizontal-space) (newline)) (defun haskell-indentation-newline-and-indent () "Ran on C-j or RET" (interactive) ;; On RET (or C-j), we: ;; - just jump to the next line if literate haskell, but outside code (if (haskell-indentation-bird-outside-codep) (haskell-indentation-delete-horizontal-space-and-newline) ;; - just jump to the next line if parse-error (on-parse-error (haskell-indentation-delete-horizontal-space-and-newline) (let* ((cc (current-column)) (ci (haskell-indentation-current-indentation)) (indentations (haskell-indentation-find-indentations-safe))) ;; - jump to the next line and reindent to at the least same level ;; if parsing was OK (skip-syntax-forward "-") (haskell-indentation-delete-horizontal-space-and-newline) (when (haskell-indentation-birdp) (insert "> ")) (haskell-indentation-reindent-to (haskell-indentation-next-indentation (- ci 1) indentations 'nofail) 'move))))) (defun haskell-indentation-next-indentation (col indentations &optional nofail) "Find the leftmost indentation which is greater than COL. Or returns the last indentation if there are no bigger ones and NOFAIL is non-nil." (when (null indentations) (error "haskell-indentation-next-indentation called with empty list")) (or (cl-find-if #'(lambda (i) (> i col)) indentations) (when nofail (car (last indentations))))) (defun haskell-indentation-previous-indentation (col indentations &optional nofail) "Find the rightmost indentation which is less than COL." (when (null indentations) (error "haskell-indentation-previous-indentation called with empty list")) (let ((rev (reverse indentations))) (or (cl-find-if #'(lambda (i) (< i col)) rev) (when nofail (car rev))))) (defun haskell-indentation-indent-line () "Auto indentation on TAB. Do nothing inside multiline comments and multiline strings. Start enumerating the indentation points to the right. The user can continue by repeatedly pressing TAB. When there is no more indentation points to the right, we switch going to the left." (interactive) ;; try to repeat (when (not (haskell-indentation-indent-line-repeat)) (setq haskell-indentation-dyn-last-direction nil) ;; do nothing if we're inside a string or comment (unless (save-excursion (beginning-of-line) (nth 8 (syntax-ppss))) ;; parse error is intentionally not catched here, it may come from ;; haskell-indentation-find-indentations-safe, but escapes the scope and aborts the ;; opertaion before any moving happens (let* ((cc (current-column)) (ci (haskell-indentation-current-indentation)) (inds (save-excursion (move-to-column ci) (haskell-indentation-find-indentations-safe))) (valid (memq ci inds)) (cursor-in-whitespace (< cc ci))) ;; can't happen right now, because of -safe, but we may want to have this in the future ;; (when (null inds) ;; (error "returned indentations empty, but no parse error")) (if (and valid cursor-in-whitespace) (move-to-column ci) (haskell-indentation-reindent-to (haskell-indentation-next-indentation ci inds 'nofail) cursor-in-whitespace)) (setq haskell-indentation-dyn-last-direction 'right) (setq haskell-indentation-dyn-first-position (haskell-indentation-current-indentation)) (setq haskell-indentation-dyn-last-indentations inds))))) (defun haskell-indentation-indent-line-repeat () "Ran if the user repeatedly presses the TAB key" (cond ((and (memq last-command '(indent-for-tab-command haskell-indentation-indent-backwards)) (eq haskell-indentation-dyn-last-direction 'region)) (let ((mark-even-if-inactive t)) (haskell-indentation-indent-rigidly (region-beginning) (region-end) 1)) t) ((and (eq last-command 'indent-for-tab-command) (memq haskell-indentation-dyn-last-direction '(left right)) haskell-indentation-dyn-last-indentations) (let* ((cc (current-column)) (ci (haskell-indentation-current-indentation))) (if (eq haskell-indentation-dyn-last-direction 'left) (haskell-indentation-reindent-to (haskell-indentation-previous-indentation ci haskell-indentation-dyn-last-indentations 'nofail)) ;; right (if (haskell-indentation-next-indentation ci haskell-indentation-dyn-last-indentations) (haskell-indentation-reindent-to (haskell-indentation-next-indentation ci haskell-indentation-dyn-last-indentations 'nofail)) ;; but failed, switch to left (setq haskell-indentation-dyn-last-direction 'left) ;; and skip to the point where the user started pressing TABs. ;; except if there are <= 2 indentation points, because this ;; behavior is very confusing in that case (when (< 2 (length haskell-indentation-dyn-last-indentations)) (haskell-indentation-reindent-to haskell-indentation-dyn-first-position)) (haskell-indentation-indent-line-repeat)))) t) (t nil))) (defun haskell-indentation-indent-region (start end) (setq haskell-indentation-dyn-last-direction 'region) (haskell-indentation-indent-rigidly start end 1) (message "Press TAB or S-TAB again to indent the region more")) (defun haskell-indentation-indent-backwards () "Indent the current line to the previous indentation point" (interactive) (cond ((and (memq last-command '(indent-for-tab-command haskell-indentation-indent-backwards)) (eq haskell-indentation-dyn-last-direction 'region)) (let ((mark-even-if-inactive t)) (haskell-indentation-indent-rigidly (region-beginning) (region-end) -1))) ((use-region-p) (setq haskell-indentation-dyn-last-direction 'region) (haskell-indentation-indent-rigidly (region-beginning) (region-end) -1) (message "Press TAB or S-TAB again to indent the region more")) (t (setq haskell-indentation-dyn-last-direction nil) (let* ((cc (current-column)) (ci (haskell-indentation-current-indentation)) (inds (save-excursion (move-to-column ci) (haskell-indentation-find-indentations-safe))) (cursor-in-whitespace (< cc ci)) (pi (haskell-indentation-previous-indentation ci inds))) (if (null pi) ;; if there are no more indentations to the left, just go to column 0 (haskell-indentation-reindent-to (car (haskell-indentation-first-indentation)) cursor-in-whitespace) (haskell-indentation-reindent-to pi cursor-in-whitespace)))))) ;;---------------------------------------- haskell-indentation show indentations UI starts here (defvar haskell-indentation-dyn-show-indentations nil "Whether showing of indentation points is enabled in this buffer.") (make-variable-buffer-local 'haskell-indentation-dyn-show-indentations) (defvar haskell-indentation-dyn-overlays nil "Overlays used by haskell-indentation-enable-show-indentations.") (make-variable-buffer-local 'haskell-indentation-dyn-overlays) (defun haskell-indentation-init-overlays (n) "Makes sure that haskell-indentation-dyn-overlays contains at least N overlays." (let* ((clen (length haskell-indentation-dyn-overlays)) (needed (- n clen))) (dotimes (n needed haskell-indentation-dyn-overlays) (setq haskell-indentation-dyn-overlays (cons (make-overlay 1 1) haskell-indentation-dyn-overlays))))) (defun haskell-indentation-unshow-overlays () "Unshows all the overlays." (mapc #'delete-overlay haskell-indentation-dyn-overlays)) (defvar haskell-indentation-pending-delay-show-overlays nil "Indicates that there are pending overlays to be shown. Holds time object value as received from `run-at-time'. Used to debounce `haskell-indentation-delay-show-overlays'.") (make-local-variable 'haskell-indentation-pending-delay-show-overlays) (defun haskell-indentation-delay-show-overlays () "Show overlays after a little while so that it does not get in the way of normal cursor movement. If there is a running show overlays timer cancel it first." (when haskell-indentation-pending-delay-show-overlays (cancel-timer haskell-indentation-pending-delay-show-overlays)) (setq haskell-indentation-pending-delay-show-overlays (run-at-time "0.1 sec" nil (lambda () (setq haskell-indentation-pending-delay-show-overlays nil) (haskell-indentation-show-overlays))))) (defun haskell-indentation-show-overlays () "Put an underscore overlay at all the indentations points in the current buffer." (if (and (memq major-mode '(haskell-mode literate-haskell-mode)) (memq 'haskell-indentation-mode minor-mode-list) haskell-indentation-dyn-show-indentations) (save-excursion (let* ((columns (progn (end-of-line) (current-column))) (ci (haskell-indentation-current-indentation)) (allinds (save-excursion (move-to-column ci); XXX: remove when haskell-indentation-find-indentations is fixed ;; don't freak out on parse-error (condition-case e (haskell-indentation-find-indentations-safe) (parse-error nil)))) ;; indentations that are easy to show (inds (cl-remove-if (lambda (i) (>= i columns)) allinds)) ;; tricky indentations, that are after the current EOL (overinds (cl-member-if (lambda (i) (>= i columns)) allinds)) ;; +1: leave space for an extra overlay to show overinds (overlays (haskell-indentation-init-overlays (+ 1 (length inds))))) (while inds (move-to-column (car inds)) (overlay-put (car overlays) 'face 'haskell-indentation-show-normal-face) (overlay-put (car overlays) 'after-string nil) (move-overlay (car overlays) (point) (+ 1 (point))) (setq inds (cdr inds)) (setq overlays (cdr overlays))) (when (and overinds haskell-indentation-show-indentations-after-eol) (let ((o (car overlays)) (s (make-string (+ 1 (- (car (last overinds)) columns)) ? ))) ;; needed for the cursor to be in the good position, see: ;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2013-03/msg00079.html (put-text-property 0 1 'cursor t s) ;; color the whole line ending overlay with hl-line face if needed (when (or hl-line-mode global-hl-line-mode) (put-text-property 0 (length s) 'face 'hl-line s)) ;; put in the underlines at the correct positions (dolist (i overinds) (put-text-property (- i columns) (+ 1 (- i columns)) 'face (if (or hl-line-mode global-hl-line-mode) 'haskell-indentation-show-hl-line-face 'haskell-indentation-show-normal-face) s)) (overlay-put o 'face nil) (overlay-put o 'after-string s) (end-of-line) (move-overlay o (point) (point)))))))) (defun haskell-indentation-enable-show-indentations () "Enable showing of indentation points in the current buffer." (interactive) (setq haskell-indentation-dyn-show-indentations t) (setq haskell-indentation-pending-delay-show-overlays nil) (add-hook 'change-major-mode-hook #'haskell-indentation-unshow-overlays nil t) (add-hook 'pre-command-hook #'haskell-indentation-unshow-overlays nil t) (add-hook 'post-command-hook #'haskell-indentation-delay-show-overlays nil t)) (defun haskell-indentation-disable-show-indentations () "Disable showing of indentation points in the current buffer." (interactive) (setq haskell-indentation-dyn-show-indentations nil) (remove-hook 'post-command-hook #'haskell-indentation-delay-show-overlays t) (haskell-indentation-unshow-overlays) (remove-hook 'change-major-mode-hook #'haskell-indentation-unshow-overlays t) (remove-hook 'pre-command-hook #'haskell-indentation-unshow-overlays t)) ;;---------------------------------------- parser starts here ;; The parser is implemented als a recursive descent parser. Each ;; parser advances the point to after the expression it parses, and ;; sets the dynamic scoped variables containing the information about ;; the indentations. The dynamic scoping allows transparent ;; backtracking to previous states of these variables. A new state ;; can be set using LET. When the scope of this function ends, ;; the variable is automatically reverted to it's old value. ;; This is basicly a performance hack. It would have been possible ;; to thread this state using a association-list through the parsers, but it ;; would be probably more complicated and slower due to the lack ;; of real closures in ELISP. ;; ;; When finished parsing, the tokenizer returns 'end-token, and ;; following-token is set to the token after point. The parser adds ;; its indentations to possible-indentations and returns to it's ;; parent, or exits non-locally by throwing parse-end, so that the ;; parent will not add new indentations to it. ;; the parse 'state': (defvar following-token) ;; the next token after parsing finished (defvar current-token) ;;; the token at the current parser point or a pseudo-token (see haskell-indentation-read-next-token) (defvar left-indent) ;; most left possible indentation (defvar starter-indent) ;; column at a keyword (defvar current-indent) ;; the most right indentation (defvar layout-indent) ;; the column of the layout list (defvar parse-line-number) ;; the number of lines parsed (defvar possible-indentations) ;; the return value of the indentations (defvar indentation-point) ;; where to stop parsing (defun haskell-indentation-goto-least-indentation () (beginning-of-line) (if (haskell-indentation-birdp) (catch 'return (while t (when (not (eq (char-after) ?>)) (forward-line) (forward-char 2) (throw 'return nil)) (let ((ps (nth 8 (syntax-ppss)))) (when ps ;; inside comment or string (goto-char ps) (beginning-of-line))) (when (and (>= 2 (haskell-indentation-current-indentation)) (not (looking-at ">\\s-*$"))) (forward-char 2) (throw 'return nil)) (when (bobp) (forward-char 2) (throw 'return nil)) (forward-line -1))) ;; not bird style (catch 'return (while (not (bobp)) (forward-comment (- (buffer-size))) (beginning-of-line) (let ((ps (nth 8 (syntax-ppss)))) (when ps ;; inside comment or string (goto-char ps))) (when (= 0 (haskell-indentation-current-indentation)) (throw 'return nil)))) (beginning-of-line) (when (bobp) (forward-comment (buffer-size))))) (defun haskell-indentation-parse-to-indentations () (save-excursion (skip-syntax-forward "-") (let ((indentation-point (point)) (layout-indent 0) (parse-line-number 0) (current-indent haskell-indentation-layout-offset) (starter-indent haskell-indentation-layout-offset) (left-indent haskell-indentation-layout-offset) (case-fold-search nil) current-token following-token possible-indentations) (haskell-indentation-goto-least-indentation) (if (<= indentation-point (point)) (haskell-indentation-first-indentation) (setq current-token (haskell-indentation-peek-token)) (catch 'parse-end (haskell-indentation-toplevel) (unless (eq current-token 'end-tokens) (parse-error "Illegal token: %s" current-token))) possible-indentations)))) (defun haskell-indentation-first-indentation () (if (haskell-indentation-birdp) '(2) '(0))) (defun haskell-indentation-find-indentations () (let ((ppss (syntax-ppss))) (cond ((nth 3 ppss) (haskell-indentation-first-indentation)) ((nth 4 ppss) (if (save-excursion (and (skip-syntax-forward "-") (eolp) (not (> (forward-line 1) 0)) (not (nth 4 (syntax-ppss))))) (haskell-indentation-parse-to-indentations) (haskell-indentation-first-indentation))) (t (haskell-indentation-parse-to-indentations))))) ;; XXX: this is a hack, the parser shouldn't return nil without parse-error (defun haskell-indentation-find-indentations-safe () (or (haskell-indentation-find-indentations) (haskell-indentation-first-indentation))) (defconst haskell-indentation-unicode-tokens '(("→" . "->") ;; #x2192 RIGHTWARDS ARROW ("∷" . "::") ;; #x2237 PROPORTION ("←" . "<-") ;; #x2190 LEFTWARDS ARROW ("⇒" . "=>") ;; #x21D2 RIGHTWARDS DOUBLE ARROW ("∀" . "forall") ;; #x2200 FOR ALL ("↢" . "-<") ;; #x2919 LEFTWARDS ARROW-TAIL ("↣" . ">-") ;; #x291A RIGHTWARDS ARROW-TAIL ("⤛" . "-<<") ;; #x291B LEFTWARDS DOUBLE ARROW-TAIL ("⤜" . ">>-") ;; #x291C RIGHTWARDS DOUBLE ARROW-TAIL ("★" . "*")) ;; #x2605 BLACK STAR "Translation dictionary from UnicodeSyntax tokens to their ASCII representation.") ;; toplevel keywords (defconst haskell-indentation-toplevel-list '(("module" . haskell-indentation-module) ("data" . (lambda () (haskell-indentation-statement-right #'haskell-indentation-data))) ("type" . (lambda () (haskell-indentation-statement-right #'haskell-indentation-data))) ("newtype" . (lambda () (haskell-indentation-statement-right #'haskell-indentation-data))) ("class" . haskell-indentation-class-declaration) ("instance" . haskell-indentation-class-declaration ))) ;; tokens in type declarations (defconst haskell-indentation-type-list '(("::" . (lambda () (haskell-indentation-with-starter (lambda () (haskell-indentation-separated #'haskell-indentation-type "->"))))) ("(" . (lambda () (haskell-indentation-list #'haskell-indentation-type ")" ","))) ("[" . (lambda () (haskell-indentation-list #'haskell-indentation-type "]" ","))) ("{" . (lambda () (haskell-indentation-list #'haskell-indentation-type "}" ","))))) ;; keywords in expressions (defconst haskell-indentation-expression-list '(("data" . haskell-indentation-data) ("type" . haskell-indentation-data) ("newtype" . haskell-indentation-data) ("if" . haskell-indentation-if) ("let" . (lambda () (haskell-indentation-phrase '(haskell-indentation-declaration-layout "in" haskell-indentation-expression)))) ("do" . (lambda () (haskell-indentation-with-starter #'haskell-indentation-expression-layout))) ("mdo" . (lambda () (haskell-indentation-with-starter #'haskell-indentation-expression-layout))) ("rec" . (lambda () (haskell-indentation-with-starter #'haskell-indentation-expression-layout))) ("case" . (lambda () (haskell-indentation-phrase '(haskell-indentation-expression "of" haskell-indentation-case-layout)))) ("\\" . (lambda () (haskell-indentation-with-starter #'haskell-indentation-lambda-maybe-lambdacase))) ("proc" . (lambda () (haskell-indentation-phrase '(haskell-indentation-expression "->" haskell-indentation-expression)))) ("where" . (lambda () (haskell-indentation-with-starter #'haskell-indentation-declaration-layout nil t))) ("::" . (lambda () (haskell-indentation-with-starter (lambda () (haskell-indentation-separated #'haskell-indentation-type "->"))))) ("=" . (lambda () (haskell-indentation-statement-right #'haskell-indentation-expression))) ("<-" . (lambda () (haskell-indentation-statement-right #'haskell-indentation-expression))) ("(" . (lambda () (haskell-indentation-list #'haskell-indentation-expression ")" '(list "," "->")))) ("[" . (lambda () (haskell-indentation-list #'haskell-indentation-expression "]" "," "|"))) ("{" . (lambda () (haskell-indentation-list #'haskell-indentation-expression "}" ","))))) ;; a layout list with expressions, such as after do (defun haskell-indentation-expression-layout () (haskell-indentation-layout #'haskell-indentation-expression)) ;; a layout list with declarations, such as after where (defun haskell-indentation-declaration-layout () (haskell-indentation-layout #'haskell-indentation-declaration)) ;; a layout list with case expressions (defun haskell-indentation-case-layout () (haskell-indentation-layout #'haskell-indentation-case)) ;; After a lambda (backslash) there are two possible cases: ;; - the new lambdacase expression, that can be recognized by the ;; next token being "case", ;; - or simply an anonymous function definition in the form of ;; "expression -> expression". (defun haskell-indentation-lambda-maybe-lambdacase () (if (string= current-token "case") (haskell-indentation-with-starter #'haskell-indentation-case-layout) (haskell-indentation-phrase-rest '(haskell-indentation-expression "->" haskell-indentation-expression)))) ;; a functional dependency (defun haskell-indentation-fundep () (haskell-indentation-with-starter (lambda () (haskell-indentation-separated #'haskell-indentation-fundep1 ",")))) (defun haskell-indentation-fundep1 () (let ((current-indent (current-column))) (while (member current-token '(value "->")) (haskell-indentation-read-next-token)) (when (and (eq current-token 'end-tokens) (member following-token '(value "->"))) (haskell-indentation-add-indentation current-indent)))) ;; the toplevel parser (defun haskell-indentation-toplevel () (haskell-indentation-layout (lambda () (let ((parser (assoc current-token haskell-indentation-toplevel-list))) (if parser (funcall (cdr parser)) (haskell-indentation-declaration)))))) ;; a type declaration (defun haskell-indentation-type () (let ((current-indent (current-column))) (catch 'return (while t (cond ((member current-token '(value operator "->")) (haskell-indentation-read-next-token)) ((eq current-token 'end-tokens) (when (member following-token '(value operator no-following-token "->" "(" "[" "{" "::")) (haskell-indentation-add-indentation current-indent)) (throw 'return nil)) (t (let ((parser (assoc current-token haskell-indentation-type-list))) (if (not parser) (throw 'return nil) (funcall (cdr parser)))))))))) ;; a data or type declaration (defun haskell-indentation-data () (haskell-indentation-with-starter (lambda () (when (string= current-token "instance") (haskell-indentation-read-next-token)) (haskell-indentation-type) (cond ((string= current-token "=") (haskell-indentation-with-starter (lambda () (haskell-indentation-separated #'haskell-indentation-type "|" "deriving")))) ((string= current-token "where") (haskell-indentation-with-starter #'haskell-indentation-expression-layout nil)))))) ;; a class declaration (defun haskell-indentation-class-declaration () (haskell-indentation-with-starter (lambda () (haskell-indentation-type) (when (string= current-token "|") (haskell-indentation-fundep)) (when (string= current-token "where") (haskell-indentation-with-starter #'haskell-indentation-declaration-layout nil))))) ;; a module declaration (defun haskell-indentation-module () (haskell-indentation-with-starter (lambda () (let ((current-indent (current-column))) (haskell-indentation-read-next-token) (when (string= current-token "(") (haskell-indentation-list #'haskell-indentation-module-export ")" ",")) (when (eq current-token 'end-tokens) (haskell-indentation-add-indentation current-indent) (throw 'parse-end nil)) (when (string= current-token "where") (haskell-indentation-read-next-token) (when (eq current-token 'end-tokens) (haskell-indentation-add-layout-indent) (throw 'parse-end nil)) (haskell-indentation-layout #'haskell-indentation-toplevel)))))) ;; an export list (defun haskell-indentation-module-export () (cond ((string= current-token "module") (let ((current-indent (current-column))) (haskell-indentation-read-next-token) (cond ((eq current-token 'end-tokens) (haskell-indentation-add-indentation current-indent)) ((eq current-token 'value) (haskell-indentation-read-next-token))))) (t (haskell-indentation-type)))) ;; an list, pair or other expression containing multiple ;; items parsed by parser, separated by sep or stmt-sep, and ending in ;; end. (defun haskell-indentation-list (parser end sep &optional stmt-sep) (haskell-indentation-with-starter `(lambda () (haskell-indentation-separated #',parser ,sep ,stmt-sep)) end)) ;; An expression starting with a keyword or paren. Skip the keyword ;; or paren. (defun haskell-indentation-with-starter (parser &optional end where-expr?) (let ((starter-column (current-column)) (current-indent current-indent) (left-indent (if (= (current-column) (haskell-indentation-current-indentation)) (current-column) left-indent))) (haskell-indentation-read-next-token) (when (eq current-token 'end-tokens) (cond ((equal following-token end) (haskell-indentation-add-indentation starter-column)) ; indent before keyword or paren (where-expr? (haskell-indentation-add-where-post-indent left-indent)) ;; left indent + where post indent (t (haskell-indentation-add-left-indent))) (throw 'parse-end nil)) (let* ((current-indent (current-column)) (starter-indent (min starter-column current-indent)) (left-indent (if end (+ current-indent haskell-indentation-starter-offset) left-indent))) (funcall parser) (cond ((eq current-token 'end-tokens) (when (equal following-token end) (haskell-indentation-add-indentation starter-indent)) ; indent before keyword or paren (when end (throw 'parse-end nil))) ;; add no more indentations if we expect a closing keyword ((equal current-token end) (haskell-indentation-read-next-token)) ;; continue (end (parse-error "Illegal token: %s" current-token)))))) (defun haskell-indentation-case-alternative () (setq left-indent (current-column)) (haskell-indentation-separated #'haskell-indentation-expression "," nil) (cond ((eq current-token 'end-tokens) (haskell-indentation-add-indentation current-indent)) ((string= current-token "->") (haskell-indentation-statement-right #'haskell-indentation-expression)) ;; otherwise fallthrough )) (defun haskell-indentation-case () (haskell-indentation-expression) (cond ((eq current-token 'end-tokens) (haskell-indentation-add-indentation current-indent)) ((string= current-token "|") (haskell-indentation-with-starter (lambda () (haskell-indentation-separated #'haskell-indentation-case-alternative "|" nil)) nil)) ((string= current-token "->") (haskell-indentation-statement-right #'haskell-indentation-expression)) ;; otherwise fallthrough )) ;; the right side of a statement. Sets current-indent ;; to the current column and cals the given parser. ;; if parsing ends here, set indentation to left-indent. (defun haskell-indentation-statement-right (parser) (haskell-indentation-read-next-token) (when (eq current-token 'end-tokens) (haskell-indentation-add-left-indent) (haskell-indentation-add-indentation current-indent) (throw 'parse-end nil)) (let ((current-indent (current-column))) (funcall parser))) (defun haskell-indentation-guard () (setq left-indent (current-column)) (haskell-indentation-separated #'haskell-indentation-expression "," nil)) ;; function or type declaration (defun haskell-indentation-declaration () (haskell-indentation-separated #'haskell-indentation-expression "," nil) (cond ((string= current-token "|") (haskell-indentation-with-starter (lambda () (haskell-indentation-separated #'haskell-indentation-guard "|" nil)) nil)) ((eq current-token 'end-tokens) (when (member following-token '("|" "=" "::" ",")) (haskell-indentation-add-indentation current-indent) (throw 'parse-end nil))))) ;; enter a layout list, where each layout item is parsed by parser. (defun haskell-indentation-layout (parser) (if (string= current-token "{") (haskell-indentation-list parser "}" ";") ;; explicit layout (haskell-indentation-implicit-layout-list parser))) (defun haskell-indentation-expression-token (token) (member token '("if" "let" "do" "case" "\\" "(" "{" "[" "::" value operator no-following-token))) ;; parse an expression until an unknown token is encountered. (defun haskell-indentation-expression () (let ((current-indent (current-column))) (catch 'return (while t (cond ((memq current-token '(value operator)) (haskell-indentation-read-next-token)) ((eq current-token 'end-tokens) (cond ((string= following-token "where") (haskell-indentation-add-where-pre-indent)) ; before a where ((haskell-indentation-expression-token following-token) (haskell-indentation-add-indentation current-indent))) ;; a normal expression (throw 'return nil)) (t (let ((parser (assoc current-token haskell-indentation-expression-list))) (when (null parser) (throw 'return nil)) ; not expression token, so exit (funcall (cdr parser)) ; run parser (when (and (eq current-token 'end-tokens) (string= (car parser) "let") (= haskell-indentation-layout-offset current-indent) (haskell-indentation-expression-token following-token)) ;; inside a layout, after a let construct ;; for example: do let a = 20 (haskell-indentation-add-layout-indent) (throw 'parse-end nil)) ;; after an 'open' expression such as 'if', exit (unless (member (car parser) '("(" "[" "{" "do" "case")) (throw 'return nil))))))))) (defun haskell-indentation-test-indentations () (interactive) (let ((indentations (save-excursion (haskell-indentation-find-indentations-safe))) (str "") (pos 0)) (while indentations (when (>= (car indentations) pos) (setq str (concat str (make-string (- (car indentations) pos) ?\ ) "|")) (setq pos (+ 1 (car indentations)))) (setq indentations (cdr indentations))) (end-of-line) (newline) (insert str))) ;; evaluate parser separated by separator and stmt-separator. ;; if stmt-separator is not nil, it will be used to set a ;; new starter-indent. ;; for example ;; [ i | i <- [1..10] ;; , (defun haskell-indentation-separated (parser separator &optional stmt-separator) (catch 'return (while t (funcall parser) (cond ((if (listp separator) (member current-token separator) (equal current-token separator)) (haskell-indentation-at-separator)) ((equal current-token stmt-separator) (setq starter-indent (current-column)) (haskell-indentation-at-separator)) ((eq current-token 'end-tokens) (cond ((or (equal following-token separator) (equal following-token stmt-separator)) ;; set an indentation before a separator, ;; for example: ;; [ 1 or [ 1 | a ;; , 2 , 20 (haskell-indentation-add-indentation starter-indent) (throw 'parse-end nil))) (throw 'return nil)) (t (throw 'return nil)))))) ;; At a separator. ;; If at a new line, set starter-indent at the separator ;; and current-indent after the separator ;; For example: ;; l = [ 1 ;; , 2 ;; , -- start now here (defun haskell-indentation-at-separator () (let ((separator-column (and (= (current-column) (haskell-indentation-current-indentation)) (current-column)))) (haskell-indentation-read-next-token) (cond ((eq current-token 'end-tokens) (haskell-indentation-add-indentation current-indent) (throw 'return nil)) (separator-column ;; on the beginning of the line (setq current-indent (current-column)) (setq starter-indent separator-column))))) ;; An implicit layout list. This sets the layout-indent ;; variable to the column where the layout starts. (defun haskell-indentation-implicit-layout-list (parser) (let* ((layout-indent (current-column)) (current-indent (current-column)) (left-indent (current-column))) (catch 'return (while t (let ((left-indent left-indent)) (funcall parser)) (cond ((member current-token '(layout-item ";")) (haskell-indentation-read-next-token)) ((eq current-token 'end-tokens) (when (or (haskell-indentation-expression-token following-token) (string= following-token ";")) (haskell-indentation-add-layout-indent)) (throw 'return nil)) (t (throw 'return nil)))))) ;; put haskell-indentation-read-next-token outside the current-indent definition ;; so it will not return 'layout-end again (when (eq current-token 'layout-end) (haskell-indentation-read-next-token))) ;; leave layout at 'layout-end or illegal token (defun haskell-indentation-if () (haskell-indentation-with-starter (lambda () (if (string= current-token "|") (haskell-indentation-with-starter (lambda () (haskell-indentation-separated #'haskell-indentation-case-alternative "|" nil)) nil) (haskell-indentation-phrase-rest '(haskell-indentation-expression "then" haskell-indentation-expression "else" haskell-indentation-expression)))) nil)) (defun haskell-indentation-phrase (phrase) (haskell-indentation-with-starter `(lambda () (haskell-indentation-phrase-rest ',phrase)) nil)) (defun haskell-indentation-phrase-rest (phrase) (let ((starter-line parse-line-number)) (let ((current-indent (current-column))) (funcall (car phrase))) (cond ((eq current-token 'end-tokens) (cond ((null (cdr phrase))) ;; fallthrough ((equal following-token (cadr phrase)) (haskell-indentation-add-indentation starter-indent) (throw 'parse-end nil)) ((string= (cadr phrase) "in") (when (= left-indent layout-indent) (haskell-indentation-add-layout-indent) (throw 'parse-end nil))) (t (throw 'parse-end nil)))) ((null (cdr phrase))) ((equal (cadr phrase) current-token) (let* ((on-new-line (= (current-column) (haskell-indentation-current-indentation))) (lines-between (- parse-line-number starter-line)) (left-indent (if (<= lines-between 0) left-indent starter-indent))) (haskell-indentation-read-next-token) (when (eq current-token 'end-tokens) (cond ((member (cadr phrase) '("then" "else")) (haskell-indentation-add-indentation (+ starter-indent haskell-indentation-ifte-offset))) ((member (cadr phrase) '("in" "->")) ;; expression ending in another expression (when (or (not haskell-indentation-indent-leftmost) (eq haskell-indentation-indent-leftmost 'both)) (haskell-indentation-add-indentation (+ starter-indent haskell-indentation-starter-offset))) (when haskell-indentation-indent-leftmost (haskell-indentation-add-indentation (if on-new-line (+ left-indent haskell-indentation-starter-offset) left-indent)))) (t (when (or (not haskell-indentation-indent-leftmost) (eq haskell-indentation-indent-leftmost 'both)) (haskell-indentation-add-indentation (+ starter-indent haskell-indentation-starter-offset))) (when haskell-indentation-indent-leftmost (haskell-indentation-add-indentation (if on-new-line (+ left-indent haskell-indentation-starter-offset) left-indent))))) (throw 'parse-end nil)) (haskell-indentation-phrase-rest (cddr phrase)))) ((string= (cadr phrase) "in")) ;; fallthrough (t (parse-error "Expecting %s" (cadr phrase)))))) (defun haskell-indentation-add-indentation (indent) (haskell-indentation-push-indentation (if (<= indent layout-indent) (+ layout-indent haskell-indentation-layout-offset) indent))) (defun haskell-indentation-add-layout-indent () (haskell-indentation-push-indentation layout-indent)) (defun haskell-indentation-add-where-pre-indent () (haskell-indentation-push-indentation (+ layout-indent haskell-indentation-where-pre-offset)) (if (= layout-indent haskell-indentation-layout-offset) (haskell-indentation-push-indentation haskell-indentation-where-pre-offset))) (defun haskell-indentation-add-where-post-indent (indent) (haskell-indentation-push-indentation (+ indent haskell-indentation-where-post-offset))) (defun haskell-indentation-add-left-indent () (haskell-indentation-add-indentation (+ left-indent haskell-indentation-left-offset))) (defun haskell-indentation-push-indentation (indent) (when (or (null possible-indentations) (< indent (car possible-indentations))) (setq possible-indentations (cons indent possible-indentations)))) (defun haskell-indentation-token-test () (let ((current-token nil) (following-token nil) (layout-indent 0) (parse-line-number 0) (indentation-point (mark))) (haskell-indentation-read-next-token))) ;; Go to the next token and set current-token to the next token. ;; The following symbols are used as pseudo tokens: ;; ;; 'layout-item: A new item in a layout list. The next token ;; will be the first token from the item. ;; 'layout-end: the end of a layout list. Next token will be ;; the first token after the layout list. ;; 'end-tokens: back at point where we started, following-token ;; will be set to the next token. ;; ;; if we are at a new line, parse-line is increased, and ;; current-indent and left-indent are set to the indentation ;; of the line. (defun haskell-indentation-read-next-token () (cond ((eq current-token 'end-tokens) 'end-tokens) ((eq current-token 'layout-end) (cond ((> layout-indent (current-column)) 'layout-end) ((= layout-indent (current-column)) (setq current-token 'layout-item)) ((< layout-indent (current-column)) (setq current-token (haskell-indentation-peek-token))))) ((eq current-token 'layout-item) (setq current-token (haskell-indentation-peek-token))) ((> layout-indent (current-column)) (setq current-token 'layout-end)) (t (haskell-indentation-skip-token) (if (>= (point) indentation-point) (progn (setq following-token (if (= (point) indentation-point) (haskell-indentation-peek-token) 'no-following-token)) (setq current-token 'end-tokens)) (when (= (current-column) (haskell-indentation-current-indentation)) ;; on a new line (setq current-indent (current-column)) (setq left-indent (current-column)) (setq parse-line-number (+ parse-line-number 1))) (cond ((> layout-indent (current-column)) (setq current-token 'layout-end)) ((= layout-indent (current-column)) (setq current-token 'layout-item)) (t (setq current-token (haskell-indentation-peek-token)))))))) (defun haskell-indentation-peek-token () "Return token starting at point." (cond ((looking-at "\\(if\\|then\\|else\\|let\\|in\\|mdo\\|rec\\|do\\|proc\\|case\\|of\\|where\\|module\\|deriving\\|data\\|type\\|newtype\\|class\\|instance\\)\\([^[:alnum:]'_]\\|$\\)") (match-string-no-properties 1)) ((looking-at "[][(){}[,;]") (match-string-no-properties 0)) ((looking-at "\\(\\\\\\|->\\|→\\|<-\\|←\\|::\\|∷\\|=\\||\\)\\([^-:!#$%&*+./<=>?@\\\\^|~]\\|$\\)") (match-string-no-properties 1)) ((looking-at "\\(→\\|←\\|∷\\)\\([^-:!#$%&*+./<=>?@\\\\^|~]\\|$\\)") (let ((tok (match-string-no-properties 1))) (or (cdr (assoc tok haskell-indentation-unicode-tokens)) tok))) ((looking-at"[-:!#$%&*+./<=>?@\\\\^|~`]" ) 'operator) (t 'value))) (defun haskell-indentation-skip-token () "Skip to the next token." (let ((case-fold-search nil)) (if (or (looking-at "'\\([^\\']\\|\\\\.\\)*'") (looking-at "\"\\([^\\\"]\\|\\\\.\\)*\"") (looking-at ; Hierarchical names always start with uppercase "[[:upper:]]\\(\\s_\\|\\sw\\|'\\)*\\(\\.\\(\\s_\\|\\sw\\|'\\)+\\)*") (looking-at "\\(\\s_\\|\\sw\\)\\(\\s_\\|\\sw\\|'\\)*") ; Only unqualified vars can start with lowercase (looking-at "[0-9][0-9oOxXeE+-]*") (looking-at "[-:!#$%&*+./<=>?@\\\\^|~]+") (looking-at "[](){}[,;]") (looking-at "`[[:alnum:]']*`")) (goto-char (match-end 0)) ;; otherwise skip until space found (skip-syntax-forward "^-")) (forward-comment (buffer-size)) (while (and (haskell-indentation-birdp) (bolp) (eq (char-after) ?>)) (forward-char) (forward-comment (buffer-size))))) (provide 'haskell-indentation) ;; Local Variables: ;; tab-width: 8 ;; End: ;;; haskell-indentation.el ends here haskell-mode-13.14.2/haskell-interactive-mode.el000066400000000000000000001322431253441665600214520ustar00rootroot00000000000000;;; haskell-interactive-mode.el --- The interactive Haskell mode ;; Copyright (C) 2011-2012 Chris Done ;; Author: Chris Done ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;;; Todo: ;;; Code: (require 'haskell-compile) (require 'haskell-navigate-imports) (require 'haskell-process) (require 'haskell-collapse) (require 'haskell-session) (require 'haskell-font-lock) (require 'haskell-presentation-mode) (require 'ansi-color) (require 'cl-lib) (require 'etags) (defvar haskell-interactive-mode-history-index) (make-variable-buffer-local 'haskell-interactive-mode-history-index) (defvar haskell-interactive-mode-history (list)) (make-variable-buffer-local 'haskell-interactive-mode-history) (defvar haskell-interactive-mode-completion-cache) (make-variable-buffer-local 'haskell-interactive-mode-completion-cache) (defvar haskell-interactive-mode-old-prompt-start nil "Mark used for the old beginning of the prompt.") (make-variable-buffer-local 'haskell-interactive-mode-old-prompt-start) (defun haskell-interactive-prompt-regex () "Generate a regex for searching for any occurence of the prompt at the beginning of the line. This should prevent any interference with prompts that look like haskell expressions." (concat "^" (regexp-quote haskell-interactive-prompt))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Globals used internally (defvar haskell-interactive-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "RET") 'haskell-interactive-mode-return) (define-key map (kbd "SPC") 'haskell-interactive-mode-space) (define-key map (kbd "C-j") 'haskell-interactive-mode-newline-indent) (define-key map (kbd "C-a") 'haskell-interactive-mode-beginning) (define-key map (kbd "") 'haskell-interactive-mode-beginning) (define-key map (kbd "C-c C-k") 'haskell-interactive-mode-clear) (define-key map (kbd "C-c C-c") 'haskell-process-interrupt) (define-key map (kbd "C-c C-f") 'next-error-follow-minor-mode) (define-key map (kbd "C-c C-z") 'haskell-interactive-switch-back) (define-key map (kbd "M-p") 'haskell-interactive-mode-history-previous) (define-key map (kbd "M-n") 'haskell-interactive-mode-history-next) (define-key map (kbd "C-c C-p") 'haskell-interactive-mode-prompt-previous) (define-key map (kbd "C-c C-n") 'haskell-interactive-mode-prompt-next) (define-key map (kbd "C-") 'haskell-interactive-mode-history-previous) (define-key map (kbd "C-") 'haskell-interactive-mode-history-next) (define-key map (kbd "TAB") 'haskell-interactive-mode-tab) (define-key map (kbd "") 'haskell-interactive-mode-kill-whole-line) map) "Interactive Haskell mode map.") (define-derived-mode haskell-interactive-mode fundamental-mode "Interactive-Haskell" "Interactive mode for Haskell. See Info node `(haskell-mode)haskell-interactive-mode' for more information. Key bindings: \\{haskell-interactive-mode-map}" :group 'haskell-interactive (setq haskell-interactive-mode-history (list)) (setq haskell-interactive-mode-history-index 0) (setq haskell-interactive-mode-completion-cache nil) (setq next-error-function 'haskell-interactive-next-error-function) (add-hook 'completion-at-point-functions 'haskell-interactive-mode-completion-at-point-function nil t) (haskell-interactive-mode-prompt)) (defvar haskell-interactive-mode-prompt-start nil "Mark used for the beginning of the prompt.") (defvar haskell-interactive-mode-result-end nil "Mark used to figure out where the end of the current result output is. Used to distinguish betwen user input.") (defvar haskell-interactive-previous-buffer nil "Records the buffer to which `haskell-interactive-switch-back' should jump. This is set by `haskell-interactive-switch', and should otherwise be nil.") (make-variable-buffer-local 'haskell-interactive-previous-buffer) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Hooks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Faces (defface haskell-interactive-face-prompt '((t :inherit font-lock-function-name-face)) "Face for the prompt." :group 'haskell-interactive) (defface haskell-interactive-face-compile-error '((t :inherit compilation-error)) "Face for compile errors." :group 'haskell-interactive) (defface haskell-interactive-face-compile-warning '((t :inherit compilation-warning)) "Face for compiler warnings." :group 'haskell-interactive) (defface haskell-interactive-face-result '((t :inherit font-lock-string-face)) "Face for the result." :group 'haskell-interactive) (defface haskell-interactive-face-garbage '((t :inherit font-lock-string-face)) "Face for trailing garbage after a command has completed." :group 'haskell-interactive) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Actions (defun haskell-interactive-mode-newline-indent () "Make newline and indent." (interactive) (newline) (indent-according-to-mode)) (defun haskell-interactive-mode-kill-whole-line () "Kill the whole REPL line." (interactive) (kill-region haskell-interactive-mode-prompt-start (line-end-position))) (defun haskell-interactive-switch-back () "Switch back to the buffer from which this interactive buffer was reached." (interactive) (if haskell-interactive-previous-buffer (switch-to-buffer-other-window haskell-interactive-previous-buffer) (message "No previous buffer."))) (defun haskell-interactive-mode-space (n) "Handle the space key." (interactive "p") (if (and (bound-and-true-p god-local-mode) (fboundp 'god-mode-self-insert)) (call-interactively 'god-mode-self-insert) (if (haskell-interactive-at-compile-message) (next-error-no-select 0) (self-insert-command n)))) (defun haskell-interactive-at-prompt () "If at prompt, returns start position of user-input, otherwise returns nil." (if (>= (point) haskell-interactive-mode-prompt-start) haskell-interactive-mode-prompt-start nil)) (define-derived-mode haskell-error-mode special-mode "Error" "Major mode for viewing Haskell compile errors.") ;; (define-key haskell-error-mode-map (kbd "q") 'quit-window) (defun haskell-interactive-mode-handle-h (&optional bound) "Handle ^H in output." (let ((bound (point-min)) (inhibit-read-only t)) (save-excursion (while (search-backward "\b" bound t 1) (save-excursion (forward-char) (let ((end (point))) (if (search-backward-regexp "[^\b]" bound t 1) (forward-char) (goto-char (point-min))) (let ((start (point))) (delete-region (max (- (point) (- end start)) (point-min)) end)))))))) (defun haskell-interactive-mode-cleanup-response (expr response) "Ignore the mess that GHCi outputs on multi-line input." (if (not (string-match "\n" expr)) response (let ((i 0) (out "") (lines (length (split-string expr "\n")))) (cl-loop for part in (split-string response "| ") do (setq out (concat out (if (> i lines) (concat (if (or (= i 0) (= i (1+ lines))) "" "| ") part) ""))) do (setq i (1+ i))) out))) (defun haskell-interactive-mode-multi-line (expr) "If a multi-line expression has been entered, then reformat it to be: :{ do the multi-liner expr :} " (if (not (string-match "\n" expr)) expr (let* ((i 0) (lines (split-string expr "\n")) (len (length lines)) (indent (make-string (length haskell-interactive-prompt) ? ))) (mapconcat 'identity (cl-loop for line in lines collect (cond ((= i 0) (concat ":{" "\n" line)) ((= i (1- len)) (concat line "\n" ":}")) (t line)) do (setq i (1+ i))) "\n")))) (defun haskell-interactive-trim (line) "Trim indentation off of lines in the REPL." (if (and (string-match "^[ ]+" line) (> (length line) (length haskell-interactive-prompt))) (substring line (length haskell-interactive-prompt)) line)) (defun haskell-interactive-mode-line-is-query (line) "Is LINE actually a :t/:k/:i?" (and (string-match "^:[itk] " line) t)) (defun haskell-interactive-mode-beginning () "Go to the start of the line." (interactive) (if (haskell-interactive-at-prompt) (goto-char haskell-interactive-mode-prompt-start) (move-beginning-of-line nil))) (defun haskell-interactive-mode-input-partial () "Get the interactive mode input up to point." (let ((input-start (haskell-interactive-at-prompt))) (unless input-start (error "not at prompt")) (buffer-substring-no-properties input-start (point)))) (defun haskell-interactive-mode-input () "Get the interactive mode input." (buffer-substring-no-properties haskell-interactive-mode-prompt-start (point-max))) (defun haskell-interactive-mode-prompt (&optional session) "Show a prompt at the end of the REPL buffer. If SESSION is non-nil, use the REPL buffer associated with SESSION, otherwise operate on the current buffer. " (with-current-buffer (if session (haskell-session-interactive-buffer session) (current-buffer)) (goto-char (point-max)) (insert (propertize haskell-interactive-prompt 'font-lock-face 'haskell-interactive-face-prompt 'read-only t 'rear-nonsticky t 'prompt t)) (let ((marker (set (make-local-variable 'haskell-interactive-mode-prompt-start) (make-marker)))) (set-marker marker (point) (current-buffer)) (when nil (let ((o (make-overlay (point) (point-max) nil nil t))) (overlay-put o 'line-prefix (make-string (length haskell-interactive-prompt) ? ))))) (when haskell-interactive-mode-scroll-to-bottom (haskell-interactive-mode-scroll-to-bottom)))) (defun haskell-interactive-mode-eval-result (session text) "Insert the result of an eval as plain text." (with-current-buffer (haskell-session-interactive-buffer session) (goto-char (point-max)) (let ((start (point))) (insert (ansi-color-apply (propertize text 'font-lock-face 'haskell-interactive-face-result 'rear-nonsticky t 'read-only t 'prompt t 'result t))) (haskell-interactive-mode-handle-h start)) (let ((marker (set (make-local-variable 'haskell-interactive-mode-result-end) (make-marker)))) (set-marker marker (point) (current-buffer))) (when haskell-interactive-mode-scroll-to-bottom (haskell-interactive-mode-scroll-to-bottom)))) (defun haskell-interactive-mode-scroll-to-bottom () "Scroll to bottom." (let ((w (get-buffer-window (current-buffer)))) (when w (goto-char (point-max)) (set-window-point w (point-max))))) (defun haskell-interactive-mode-compile-error (session message) "Echo an error." (haskell-interactive-mode-compile-message session message 'haskell-interactive-face-compile-error)) (defun haskell-interactive-mode-compile-warning (session message) "Warning message." (haskell-interactive-mode-compile-message session message 'haskell-interactive-face-compile-warning)) (defun haskell-interactive-mode-compile-message (session message type) "Echo a compiler warning." (with-current-buffer (haskell-session-interactive-buffer session) (setq next-error-last-buffer (current-buffer)) (save-excursion (haskell-interactive-mode-goto-end-point) (let ((lines (string-match "^\\(.*\\)\n\\([[:unibyte:][:nonascii:]]+\\)" message))) (when lines (insert (propertize (concat (match-string 1 message) " …\n") 'font-lock-face type 'read-only t 'rear-nonsticky t 'expandable t)) (insert (propertize (concat (match-string 2 message) "\n") 'font-lock-face type 'read-only t 'rear-nonsticky t 'collapsible t 'invisible haskell-interactive-mode-hide-multi-line-errors 'message-length (length (match-string 2 message))))) (unless lines (insert (propertize (concat message "\n") 'font-lock-face type 'read-only t 'rear-nonsticky t))))))) (defun haskell-interactive-mode-insert (session message) "Echo a read only piece of text before the prompt." (with-current-buffer (haskell-session-interactive-buffer session) (save-excursion (haskell-interactive-mode-goto-end-point) (insert (propertize message 'read-only t 'rear-nonsticky t))))) (defun haskell-interactive-mode-goto-end-point () "Go to the 'end' of the buffer (before the prompt.)" (goto-char haskell-interactive-mode-prompt-start) (goto-char (line-beginning-position))) (defun haskell-interactive-mode-history-add (input) "Add item to the history." (setq haskell-interactive-mode-history (cons "" (cons input (cl-remove-if (lambda (i) (or (string= i input) (string= i ""))) haskell-interactive-mode-history)))) (setq haskell-interactive-mode-history-index 0)) (defun haskell-mode-message-line (str) "Message only one line, multiple lines just disturbs the programmer." (let ((lines (split-string str "\n" t))) (when (and (car lines) (stringp (car lines))) (message "%s" (concat (car lines) (if (and (cdr lines) (stringp (cadr lines))) (format " [ %s .. ]" (haskell-string-take (haskell-string-trim (cadr lines)) 10)) "")))))) (defun haskell-interactive-mode-tab () "Do completion if at prompt or else try collapse/expand." (interactive) (cond ((haskell-interactive-at-prompt) (completion-at-point)) ((get-text-property (point) 'collapsible) (let ((column (current-column))) (search-backward-regexp "^[^ ]") (haskell-interactive-mode-tab-expand) (goto-char (+ column (line-beginning-position))))) (t (haskell-interactive-mode-tab-expand)))) (defun haskell-interactive-mode-tab-expand () "Expand the rest of the message." (cond ((get-text-property (point) 'expandable) (let* ((pos (1+ (line-end-position))) (visibility (get-text-property pos 'invisible)) (length (1+ (get-text-property pos 'message-length)))) (let ((inhibit-read-only t)) (put-text-property pos (+ pos length) 'invisible (not visibility))))))) (defconst haskell-interactive-mode-error-regexp "^\\([A-Z]?:?[^\r\n:]+\\):\\([0-9()-:]+\\):?") (defun haskell-interactive-at-compile-message () "Am I on a compile message?" (and (not (haskell-interactive-at-prompt)) (save-excursion (goto-char (line-beginning-position)) (looking-at haskell-interactive-mode-error-regexp)))) (defun haskell-interactive-mode-error-backward (&optional count) "Go backward to the previous error." (interactive) (search-backward-regexp haskell-interactive-mode-error-regexp nil t count)) (defun haskell-interactive-mode-error-forward (&optional count) "Go forward to the next error, or return to the REPL." (interactive) (goto-char (line-end-position)) (if (search-forward-regexp haskell-interactive-mode-error-regexp nil t count) (progn (goto-char (line-beginning-position)) t) (progn (goto-char (point-max)) nil))) (defun haskell-interactive-mode-delete-compile-messages (session &optional file-name) "Delete compile messages in REPL buffer. If FILE-NAME is non-nil, restrict to removing messages concerning FILE-NAME only." (with-current-buffer (haskell-session-interactive-buffer session) (save-excursion (goto-char (point-min)) (when (search-forward-regexp "^Compilation failed.$" nil t 1) (let ((inhibit-read-only t)) (delete-region (line-beginning-position) (1+ (line-end-position)))) (goto-char (point-min))) (while (when (re-search-forward haskell-interactive-mode-error-regexp nil t) (let ((msg-file-name (match-string-no-properties 1)) (msg-startpos (line-beginning-position))) ;; skip over hanging continuation message lines (while (progn (forward-line) (looking-at "^[ ]+"))) (when (or (not file-name) (string= file-name msg-file-name)) (let ((inhibit-read-only t)) (set-text-properties msg-startpos (point) nil)) (delete-region msg-startpos (point)) )) t))))) ;;;###autoload (defun haskell-interactive-mode-reset-error (session) "Reset the error cursor position." (interactive) (with-current-buffer (haskell-session-interactive-buffer session) (haskell-interactive-mode-goto-end-point) (let ((mrk (point-marker))) (haskell-session-set session 'next-error-locus nil) (haskell-session-set session 'next-error-region (cons mrk (copy-marker mrk t)))) (goto-char (point-max)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Misc (defun haskell-session-interactive-buffer (s) "Get the session interactive buffer." (let ((buffer (haskell-session-get s 'interactive-buffer))) (if (and buffer (buffer-live-p buffer)) buffer (let ((buffer (get-buffer-create (format "*%s*" (haskell-session-name s))))) (haskell-session-set-interactive-buffer s buffer) (with-current-buffer buffer (haskell-interactive-mode) (haskell-session-assign s)) (switch-to-buffer-other-window buffer) buffer)))) (defun haskell-process-cabal-live (state buffer) "Do live updates for Cabal processes." (haskell-interactive-mode-insert (haskell-process-session (cadr state)) (replace-regexp-in-string haskell-process-prompt-regex "" (substring buffer (cl-cadddr state)))) (setf (cl-cdddr state) (list (length buffer))) nil) (defun haskell-process-parse-error (string) "Parse the line number from the error." (let ((span nil)) (cl-loop for regex in haskell-compilation-error-regexp-alist do (when (string-match (car regex) string) (setq span (list :file (match-string 1 string) :line (string-to-number (match-string 2 string)) :col (string-to-number (match-string 4 string)) :line2 (when (match-string 3 string) (string-to-number (match-string 3 string))) :col2 (when (match-string 5 string) (string-to-number (match-string 5 string))))))) span)) (defun haskell-process-suggest-add-package (session msg) "Add the (matched) module to your cabal file." (let* ((suggested-package (match-string 1 msg)) (package-name (replace-regexp-in-string "-[^-]+$" "" suggested-package)) (version (progn (string-match "\\([^-]+\\)$" suggested-package) (match-string 1 suggested-package))) (cabal-file (concat (haskell-session-name session) ".cabal"))) (when (y-or-n-p (format "Add `%s' to %s?" package-name cabal-file)) (haskell-cabal-add-dependency package-name version nil t) (when (y-or-n-p (format "Enable -package %s in the GHCi session?" package-name)) (haskell-process-queue-without-filters (haskell-session-process session) (format ":set -package %s" package-name)))))) (defun haskell-process-suggest-remove-import (session file import line) "Suggest removing or commenting out IMPORT on LINE." (let ((continue t) (first t)) (cl-case (read-event (propertize (format "%sThe import line `%s' is redundant. Remove? (y, n, c: comment out) " (if (not first) "Please answer n, y or c: " "") import) 'face 'minibuffer-prompt)) (?y (haskell-process-find-file session file) (save-excursion (goto-char (point-min)) (forward-line (1- line)) (goto-char (line-beginning-position)) (delete-region (line-beginning-position) (line-end-position)))) (?n (message "Ignoring redundant import %s" import)) (?c (haskell-process-find-file session file) (save-excursion (goto-char (point-min)) (forward-line (1- line)) (goto-char (line-beginning-position)) (insert "-- ")))))) (defun haskell-process-find-file (session file) "Find the given file in the project." (find-file (cond ((file-exists-p (concat (haskell-session-current-dir session) "/" file)) (concat (haskell-session-current-dir session) "/" file)) ((file-exists-p (concat (haskell-session-cabal-dir session) "/" file)) (concat (haskell-session-cabal-dir session) "/" file)) (t file)))) (defun haskell-process-suggest-pragma (session pragma extension file) "Suggest to add something to the top of the file." (let ((string (format "{-# %s %s #-}" pragma extension))) (when (y-or-n-p (format "Add %s to the top of the file? " string)) (haskell-process-find-file session file) (save-excursion (goto-char (point-min)) (insert (concat string "\n")))))) (defun haskell-interactive-mode-insert-error (response) "Insert an error message." (insert "\n" (haskell-fontify-as-mode response 'haskell-mode)) (haskell-interactive-mode-prompt)) (defun haskell-interactive-popup-error (response) "Popup an error." (if haskell-interactive-popup-errors (let ((buf (get-buffer-create "*HS-Error*"))) (pop-to-buffer buf nil t) (with-current-buffer buf (haskell-error-mode) (let ((inhibit-read-only t)) (erase-buffer) (insert (propertize response 'font-lock-face 'haskell-interactive-face-compile-error)) (goto-char (point-min)) (delete-blank-lines) (insert (propertize "-- Hit `q' to close this window.\n\n" 'font-lock-face 'font-lock-comment-face)) (save-excursion (goto-char (point-max)) (insert (propertize "\n-- To disable popups, customize `haskell-interactive-popup-errors'.\n\n" 'font-lock-face 'font-lock-comment-face)))))) (haskell-interactive-mode-insert-error response))) (defun haskell-interactive-next-error-function (&optional n reset) "See `next-error-function' for more information." (let* ((session (haskell-interactive-session)) (next-error-region (haskell-session-get session 'next-error-region)) (next-error-locus (haskell-session-get session 'next-error-locus)) (reset-locus nil)) (when (and next-error-region (or reset (and (/= n 0) (not next-error-locus)))) (goto-char (car next-error-region)) (unless (looking-at haskell-interactive-mode-error-regexp) (haskell-interactive-mode-error-forward)) (setq reset-locus t) (unless (looking-at haskell-interactive-mode-error-regexp) (error "no errors found"))) ;; move point if needed (cond (reset-locus nil) ((> n 0) (unless (haskell-interactive-mode-error-forward n) (error "no more errors"))) ((< n 0) (unless (haskell-interactive-mode-error-backward (- n)) (error "no more errors")))) (let ((orig-line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) (when (string-match haskell-interactive-mode-error-regexp orig-line) (let* ((msgmrk (set-marker (make-marker) (line-beginning-position))) (location (haskell-process-parse-error orig-line)) (file (plist-get location :file)) (line (plist-get location :line)) (col1 (plist-get location :col)) (col2 (plist-get location :col2)) (cabal-relative-file (expand-file-name file (haskell-session-cabal-dir session))) (src-relative-file (expand-file-name file (haskell-session-current-dir session))) (real-file (cond ((file-exists-p cabal-relative-file) cabal-relative-file) ((file-exists-p src-relative-file) src-relative-file)))) (haskell-session-set session 'next-error-locus msgmrk) (if real-file (let ((m1 (make-marker)) (m2 (make-marker))) (with-current-buffer (find-file-noselect real-file) (save-excursion (goto-char (point-min)) (forward-line (1- line)) (set-marker m1 (+ col1 (point) -1)) (when col2 (set-marker m2 (- (point) col2))))) ;; ...finally select&hilight error locus (compilation-goto-locus msgmrk m1 (and (marker-position m2) m2))) (error "don't know where to find %S" file))))))) (defun haskell-interactive-session () "Get the `haskell-session', throw an error if it's not available." (or (haskell-session-maybe) (haskell-session-assign (or (haskell-session-from-buffer) (haskell-session-choose) (error "No session associated with this buffer. Try M-x haskell-session-change or report this as a bug."))))) (defun haskell-interactive-process () "Get the Haskell session." (or (haskell-session-process (haskell-interactive-session)) (error "No Haskell session/process associated with this buffer. Maybe run M-x haskell-process-restart?"))) (defun haskell-interactive-mode-do-presentation (expr) "Present the given expression. Requires the `present` package to be installed. Will automatically import it qualified as Present." (let ((p (haskell-interactive-process))) ;; If Present.code isn't available, we probably need to run the ;; setup. (unless (string-match "^Present" (haskell-process-queue-sync-request p ":t Present.encode")) (haskell-interactive-mode-setup-presentation p)) ;; Happily, let statements don't affect the `it' binding in any ;; way, so we can fake it, no pun intended. (let ((error (haskell-process-queue-sync-request p (concat "let it = Present.asData (" expr ")")))) (if (not (string= "" error)) (haskell-interactive-mode-eval-result (haskell-interactive-session) (concat error "\n")) (let ((hash (haskell-interactive-mode-presentation-hash))) (haskell-process-queue-sync-request p (format "let %s = Present.asData (%s)" hash expr)) (let* ((presentation (haskell-interactive-mode-present-id hash (list 0)))) (insert "\n") (haskell-interactive-mode-insert-presentation hash presentation) (haskell-interactive-mode-eval-result (haskell-interactive-session) "\n")))) (haskell-interactive-mode-prompt (haskell-interactive-session))))) (defun haskell-interactive-mode-present-id (hash id) "Generate a presentation for the current expression at ID." ;; See below for commentary of this statement. (let ((p (haskell-interactive-process))) (haskell-process-queue-without-filters p "let _it = it") (let* ((text (haskell-process-queue-sync-request p (format "Present.putStr (Present.encode (Present.fromJust (Present.present (Present.fromJust (Present.fromList [%s])) %s)))" (mapconcat 'identity (mapcar 'number-to-string id) ",") hash))) (reply (if (string-match "^*** " text) '((rep nil)) (read text)))) ;; Not necessary, but nice to restore it to the expression that ;; the user actually typed in. (haskell-process-queue-without-filters p "let it = _it") reply))) (defun haskell-presentation-present-slot (btn) "The callback to evaluate the slot and present it in place of the button." (let ((id (button-get btn 'presentation-id)) (hash (button-get btn 'hash)) (parent-rep (button-get btn 'parent-rep)) (continuation (button-get btn 'continuation))) (let ((point (point))) (button-put btn 'invisible t) (delete-region (button-start btn) (button-end btn)) (haskell-interactive-mode-insert-presentation hash (haskell-interactive-mode-present-id hash id) parent-rep continuation) (when (> (point) point) (goto-char (1+ point)))))) (defun haskell-interactive-mode-presentation-slot (hash slot parent-rep &optional continuation) "Make a slot at point, pointing to ID." (let ((type (car slot)) (id (cadr slot))) (if (member (intern type) '(Integer Char Int Float Double)) (haskell-interactive-mode-insert-presentation hash (haskell-interactive-mode-present-id hash id) parent-rep continuation) (haskell-interactive-mode-presentation-slot-button slot parent-rep continuation hash)))) (defun haskell-interactive-mode-presentation-slot-button (slot parent-rep continuation hash) (let ((start (point)) (type (car slot)) (id (cadr slot))) (insert (propertize type 'font-lock-face '(:height 0.8 :underline t :inherit font-lock-comment-face))) (let ((button (make-text-button start (point) :type 'haskell-presentation-slot-button))) (button-put button 'hide-on-click t) (button-put button 'presentation-id id) (button-put button 'parent-rep parent-rep) (button-put button 'continuation continuation) (button-put button 'hash hash)))) (defun haskell-interactive-mode-insert-presentation (hash presentation &optional parent-rep continuation) "Insert the presentation, hooking up buttons for each slot." (let* ((rep (cadr (assoc 'rep presentation))) (text (cadr (assoc 'text presentation))) (type (cadr (assoc 'type presentation))) (slots (cadr (assoc 'slots presentation))) (nullary (null slots))) (cond ((string= "integer" rep) (insert (propertize text 'font-lock-face 'font-lock-constant))) ((string= "floating" rep) (insert (propertize text 'font-lock-face 'font-lock-constant))) ((string= "char" rep) (insert (propertize (if (string= "string" parent-rep) (replace-regexp-in-string "^'\\(.+\\)'$" "\\1" text) text) 'font-lock-face 'font-lock-string-face))) ((string= "tuple" rep) (insert "(") (let ((first t)) (cl-loop for slot in slots do (unless first (insert ",")) do (haskell-interactive-mode-presentation-slot hash slot rep) do (setq first nil))) (insert ")")) ((string= "list" rep) (if (null slots) (if continuation (progn (delete-char -1) (delete-indentation)) (insert "[]")) (let ((i 0)) (unless continuation (insert "[")) (let ((start-column (current-column))) (cl-loop for slot in slots do (haskell-interactive-mode-presentation-slot hash slot rep (= i (1- (length slots)))) do (when (not (= i (1- (length slots)))) (insert "\n") (indent-to (1- start-column)) (insert ",")) do (setq i (1+ i)))) (unless continuation (insert "]"))))) ((string= "string" rep) (unless (string= "string" parent-rep) (insert (propertize "\"" 'font-lock-face 'font-lock-string-face))) (cl-loop for slot in slots do (haskell-interactive-mode-presentation-slot hash slot rep)) (unless (string= "string" parent-rep) (insert (propertize "\"" 'font-lock-face 'font-lock-string-face)))) ((string= "alg" rep) (when (and parent-rep (not nullary) (not (string= "list" parent-rep))) (insert "(")) (let ((start-column (current-column))) (insert (propertize text 'font-lock-face 'font-lock-type-face)) (cl-loop for slot in slots do (insert "\n") do (indent-to (+ 2 start-column)) do (haskell-interactive-mode-presentation-slot hash slot rep))) (when (and parent-rep (not nullary) (not (string= "list" parent-rep))) (insert ")"))) ((string= "record" rep) (let ((start-column (current-column))) (insert (propertize text 'font-lock-face 'font-lock-type-face) " { ") (cl-loop for field in slots do (insert "\n") do (indent-to (+ 2 start-column)) do (let ((name (nth 0 field)) (slot (nth 1 field))) (insert name " = ") (haskell-interactive-mode-presentation-slot hash slot rep))) (insert "\n") (indent-to start-column) (insert "}"))) ((eq rep nil) (insert (propertize "?" 'font-lock-face 'font-lock-warning))) (t (let ((err "Unable to present! This very likely means Emacs is out of sync with the `present' package. You should make sure they're both up to date, or report a bug.")) (insert err) (error err)))))) (defun haskell-interactive-mode-setup-presentation (p) "Setup the GHCi REPL for using presentations. Using asynchronous queued commands as opposed to sync at this stage, as sync would freeze up the UI a bit, and we actually don't care when the thing completes as long as it's soonish." ;; Import dependencies under Present.* namespace (haskell-process-queue-without-filters p "import qualified Data.Maybe as Present") (haskell-process-queue-without-filters p "import qualified Data.ByteString.Lazy as Present") (haskell-process-queue-without-filters p "import qualified Data.AttoLisp as Present") (haskell-process-queue-without-filters p "import qualified Present.ID as Present") (haskell-process-queue-without-filters p "import qualified Present as Present") ;; Make a dummy expression to avoid "Loading package" nonsense (haskell-process-queue-without-filters p "Present.present (Present.fromJust (Present.fromList [0])) ()")) (defvar haskell-interactive-mode-presentation-hash 0 "Counter for the hash.") (defun haskell-interactive-mode-presentation-hash () "Generate a presentation hash." (format "_present_%s" (setq haskell-interactive-mode-presentation-hash (1+ haskell-interactive-mode-presentation-hash)))) (define-button-type 'haskell-presentation-slot-button 'action 'haskell-presentation-present-slot 'follow-link t 'help-echo "Click to expand…") (defun haskell-interactive-mode-history-toggle (n) "Toggle the history n items up or down." (unless (null haskell-interactive-mode-history) (setq haskell-interactive-mode-history-index (mod (+ haskell-interactive-mode-history-index n) (length haskell-interactive-mode-history))) (unless (zerop haskell-interactive-mode-history-index) (message "History item: %d" haskell-interactive-mode-history-index)) (haskell-interactive-mode-set-prompt (nth haskell-interactive-mode-history-index haskell-interactive-mode-history)))) (defun haskell-interactive-mode-set-prompt (p) "Set (and overwrite) the current prompt." (with-current-buffer (haskell-session-interactive-buffer (haskell-interactive-session)) (goto-char haskell-interactive-mode-prompt-start) (delete-region (point) (point-max)) (insert p))) (defun haskell-interactive-mode-history-previous (arg) "Cycle backwards through input history." (interactive "*p") (when (haskell-interactive-at-prompt) (if (not (zerop arg)) (haskell-interactive-mode-history-toggle arg) (setq haskell-interactive-mode-history-index 0) (haskell-interactive-mode-history-toggle 1)))) (defun haskell-interactive-mode-history-next (arg) "Cycle forward through input history." (interactive "*p") (when (haskell-interactive-at-prompt) (if (not (zerop arg)) (haskell-interactive-mode-history-toggle (- arg)) (setq haskell-interactive-mode-history-index 0) (haskell-interactive-mode-history-toggle -1)))) (defun haskell-interactive-mode-prompt-previous () "Jump to the previous prompt." (interactive) (let ((prev-prompt-pos (save-excursion (beginning-of-line) ;; otherwise prompt at current line matches (and (search-backward-regexp (haskell-interactive-prompt-regex) nil t) (match-end 0))))) (when prev-prompt-pos (goto-char prev-prompt-pos)))) (defun haskell-interactive-mode-prompt-next () "Jump to the next prompt." (interactive) (search-forward-regexp (haskell-interactive-prompt-regex) nil t)) (defun haskell-interactive-mode-clear () "Clear the screen and put any current input into the history." (interactive) (let ((session (haskell-interactive-session))) (with-current-buffer (haskell-session-interactive-buffer session) (let ((inhibit-read-only t)) (set-text-properties (point-min) (point-max) nil)) (delete-region (point-min) (point-max)) (remove-overlays) (haskell-interactive-mode-prompt session) (haskell-session-set session 'next-error-region nil) (haskell-session-set session 'next-error-locus nil)) (with-current-buffer (get-buffer-create "*haskell-process-log*") (delete-region (point-min) (point-max)) (remove-overlays)))) (defun haskell-interactive-mode-completion-at-point-function () "Offer completions for partial expression between prompt and point" (when (haskell-interactive-at-prompt) (let* ((process (haskell-interactive-process)) (session (haskell-interactive-session)) (inp (haskell-interactive-mode-input-partial))) (if (string= inp (car-safe haskell-interactive-mode-completion-cache)) (cdr haskell-interactive-mode-completion-cache) (let* ((resp2 (haskell-process-get-repl-completions process inp)) (rlen (- (length inp) (length (car resp2)))) (coll (append (if (string-prefix-p inp "import") '("import")) (if (string-prefix-p inp "let") '("let")) (cdr resp2))) (result (list (- (point) rlen) (point) coll))) (setq haskell-interactive-mode-completion-cache (cons inp result)) result))))) (defun haskell-interactive-mode-trigger-compile-error (state response) "Look for an compile error; if there is one, pop that up in a buffer, similar to `debug-on-error'." (when (and haskell-interactive-types-for-show-ambiguous (string-match "^\n:[0-9]+:[0-9]+:" response) (not (string-match "^\n:[0-9]+:[0-9]+:[\n ]+Warning:" response))) (let ((inhibit-read-only t)) (delete-region haskell-interactive-mode-prompt-start (point)) (set-marker haskell-interactive-mode-prompt-start haskell-interactive-mode-old-prompt-start) (goto-char (point-max))) (cond ((and (not (haskell-interactive-mode-line-is-query (elt state 2))) (or (string-match "No instance for (?Show[ \n]" response) (string-match "Ambiguous type variable " response))) (haskell-process-reset (haskell-interactive-process)) (let ((resp (haskell-process-queue-sync-request (haskell-interactive-process) (concat ":t " (buffer-substring-no-properties haskell-interactive-mode-prompt-start (point-max)))))) (cond ((not (string-match ":" resp)) (haskell-interactive-mode-insert-error resp)) (t (haskell-interactive-popup-error response))))) (t (haskell-interactive-popup-error response) t)) t)) ;;;###autoload (defun haskell-interactive-mode-echo (session message &optional mode) "Echo a read only piece of text before the prompt." (with-current-buffer (haskell-session-interactive-buffer session) (save-excursion (haskell-interactive-mode-goto-end-point) (insert (if mode (haskell-fontify-as-mode (concat message "\n") mode) (propertize (concat message "\n") 'read-only t 'rear-nonsticky t)))))) (defun haskell-interactive-mode-splices-buffer (session) "Get the splices buffer for the current session." (get-buffer-create (haskell-interactive-mode-splices-buffer-name session))) (defun haskell-interactive-mode-splices-buffer-name (session) (format "*%s:splices*" (haskell-session-name session))) (defun haskell-interactive-mode-compile-splice (session message) "Echo a compiler splice." (with-current-buffer (haskell-interactive-mode-splices-buffer session) (unless (eq major-mode 'haskell-mode) (haskell-mode)) (let* ((parts (split-string message "\n ======>\n")) (file-and-decl-lines (split-string (nth 0 parts) "\n")) (file (nth 0 file-and-decl-lines)) (decl (mapconcat #'identity (cdr file-and-decl-lines) "\n")) (output (nth 1 parts))) (insert "-- " file "\n") (let ((start (point))) (insert decl "\n") (indent-rigidly start (point) -4)) (insert "-- =>\n") (let ((start (point))) (insert output "\n") (indent-rigidly start (point) -4))))) (defun haskell-interactive-mode-insert-garbage (session message) "Echo a read only piece of text before the prompt." (with-current-buffer (haskell-session-interactive-buffer session) (save-excursion (haskell-interactive-mode-goto-end-point) (insert (propertize message 'font-lock-face 'haskell-interactive-face-garbage 'read-only t 'rear-nonsticky t))))) ;;;###autoload (defun haskell-process-show-repl-response (line) "Send LINE to the GHCi process and echo the result in some fashion. Result will be printed in the minibuffer or presented using haskell-present, depending on variable `haskell-process-use-presentation-mode'." (let ((process (haskell-interactive-process))) (haskell-process-queue-command process (make-haskell-command :state (cons process line) :go (lambda (state) (haskell-process-send-string (car state) (cdr state))) :complete (lambda (state response) (if haskell-process-use-presentation-mode (haskell-present (haskell-process-session (car state)) response) (haskell-mode-message-line response))))))) (provide 'haskell-interactive-mode) ;;; haskell-interactive-mode.el ends here haskell-mode-13.14.2/haskell-load.el000066400000000000000000000472161253441665600171370ustar00rootroot00000000000000;;; haskell-load.el --- Compiling and loading modules in the GHCi process ;; Copyright (c) 2014 Chris Done. All rights reserved. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: (require 'cl-lib) (require 'haskell-process) (require 'haskell-interactive-mode) (require 'haskell-modules) (require 'haskell-commands) (require 'haskell-session) (defun haskell-process-look-config-changes (session) "Checks whether a cabal configuration file has changed. Restarts the process if that is the case." (let ((current-checksum (haskell-session-get session 'cabal-checksum)) (new-checksum (haskell-cabal-compute-checksum (haskell-session-get session 'cabal-dir)))) (when (not (string= current-checksum new-checksum)) (haskell-interactive-mode-echo session (format "Cabal file changed: %s" new-checksum)) (haskell-session-set-cabal-checksum session (haskell-session-get session 'cabal-dir)) (unless (and haskell-process-prompt-restart-on-cabal-change (not (y-or-n-p "Cabal file changed; restart GHCi process? "))) (haskell-process-start (haskell-interactive-session)))))) (defun haskell-process-live-build (process buffer echo-in-repl) "Show live updates for loading files." (cond ((haskell-process-consume process (concat "\\[[ ]*\\([0-9]+\\) of \\([0-9]+\\)\\]" " Compiling \\([^ ]+\\)[ ]+" "( \\([^ ]+\\), \\([^ ]+\\) )[^\r\n]*[\r\n]+")) (haskell-process-echo-load-message process buffer echo-in-repl nil) t) ((haskell-process-consume process (concat "\\[[ ]*\\([0-9]+\\) of \\([0-9]+\\)\\]" " Compiling \\[TH\\] \\([^ ]+\\)[ ]+" "( \\([^ ]+\\), \\([^ ]+\\) )[^\r\n]*[\r\n]+")) (haskell-process-echo-load-message process buffer echo-in-repl t) t) ((haskell-process-consume process "Loading package \\([^ ]+\\) ... linking ... done.\n") (haskell-mode-message-line (format "Loading: %s" (match-string 1 buffer))) t) ((haskell-process-consume process "^Preprocessing executables for \\(.+?\\)\\.\\.\\.") (let ((msg (format "Preprocessing: %s" (match-string 1 buffer)))) (haskell-interactive-mode-echo (haskell-process-session process) msg) (haskell-mode-message-line msg))) ((haskell-process-consume process "Linking \\(.+?\\) \\.\\.\\.") (let ((msg (format "Linking: %s" (match-string 1 buffer)))) (haskell-interactive-mode-echo (haskell-process-session process) msg) (haskell-mode-message-line msg))) ((haskell-process-consume process "\nBuilding \\(.+?\\)\\.\\.\\.") (let ((msg (format "Building: %s" (match-string 1 buffer)))) (haskell-interactive-mode-echo (haskell-process-session process) msg) (haskell-mode-message-line msg))))) (defun haskell-process-load-complete (session process buffer reload module-buffer &optional cont) "Handle the complete loading response. BUFFER is the string of text being sent over the process pipe. MODULE-BUFFER is the actual Emacs buffer of the module being loaded." (when (get-buffer (format "*%s:splices*" (haskell-session-name session))) (with-current-buffer (haskell-interactive-mode-splices-buffer session) (erase-buffer))) (cond ((haskell-process-consume process "Ok, modules loaded: \\(.+\\)\\.$") (let* ((modules (haskell-process-extract-modules buffer)) (cursor (haskell-process-response-cursor process))) (haskell-process-set-response-cursor process 0) (let ((warning-count 0)) (while (haskell-process-errors-warnings session process buffer) (setq warning-count (1+ warning-count))) (haskell-process-set-response-cursor process cursor) (if (and (not reload) haskell-process-reload-with-fbytecode) (haskell-process-reload-with-fbytecode process module-buffer) (haskell-process-import-modules process (car modules))) (haskell-mode-message-line (if reload "Reloaded OK." "OK.")) (when cont (condition-case e (funcall cont t) (error (message "%S" e)) (quit nil)))))) ((haskell-process-consume process "Failed, modules loaded: \\(.+\\)\\.$") (let* ((modules (haskell-process-extract-modules buffer)) (cursor (haskell-process-response-cursor process))) (haskell-process-set-response-cursor process 0) (while (haskell-process-errors-warnings session process buffer)) (haskell-process-set-response-cursor process cursor) (if (and (not reload) haskell-process-reload-with-fbytecode) (haskell-process-reload-with-fbytecode process module-buffer) (haskell-process-import-modules process (car modules))) (haskell-interactive-mode-compile-error session "Compilation failed.") (when cont (condition-case e (funcall cont nil) (error (message "%S" e)) (quit nil))))))) (defun haskell-process-suggest-imports (session file modules ident) "Given a list of MODULES, suggest adding them to the import section." (cl-assert session) (cl-assert file) (cl-assert ident) (let* ((process (haskell-session-process session)) (suggested-already (haskell-process-suggested-imports process)) (module (cond ((> (length modules) 1) (when (y-or-n-p (format "Identifier `%s' not in scope, choose module to import?" ident)) (haskell-complete-module-read "Module: " modules))) ((= (length modules) 1) (let ((module (car modules))) (unless (member module suggested-already) (haskell-process-set-suggested-imports process (cons module suggested-already)) (when (y-or-n-p (format "Identifier `%s' not in scope, import `%s'?" ident module)) module))))))) (when module (haskell-process-find-file session file) (haskell-add-import module)))) (defun haskell-process-trigger-suggestions (session msg file line) "Trigger prompting to add any extension suggestions." (cond ((let ((case-fold-search nil)) (or (and (string-match " -X\\([A-Z][A-Za-z]+\\)" msg) (not (string-match "\\([A-Z][A-Za-z]+\\) is deprecated" msg))) (string-match "Use \\([A-Z][A-Za-z]+\\) to permit this" msg) (string-match "Use \\([A-Z][A-Za-z]+\\) to allow" msg) (string-match "use \\([A-Z][A-Za-z]+\\)" msg) (string-match "You need \\([A-Z][A-Za-z]+\\)" msg))) (when haskell-process-suggest-language-pragmas (haskell-process-suggest-pragma session "LANGUAGE" (match-string 1 msg) file))) ((string-match " The \\(qualified \\)?import of[ ][‘`‛]\\([^ ]+\\)['’] is redundant" msg) (when haskell-process-suggest-remove-import-lines (haskell-process-suggest-remove-import session file (match-string 2 msg) line))) ((string-match "Warning: orphan instance: " msg) (when haskell-process-suggest-no-warn-orphans (haskell-process-suggest-pragma session "OPTIONS" "-fno-warn-orphans" file))) ((or (string-match "against inferred type [‘`‛]\\[Char\\]['’]" msg) (string-match "with actual type [‘`‛]\\[Char\\]['’]" msg)) (when haskell-process-suggest-overloaded-strings (haskell-process-suggest-pragma session "LANGUAGE" "OverloadedStrings" file))) ((string-match "^Not in scope: .*[‘`‛]\\(.+\\)['’]$" msg) (let* ((match1 (match-string 1 msg)) (ident (if (string-match "^[A-Za-z0-9_'.]+\\.\\(.+\\)$" match1) ;; Skip qualification. (match-string 1 match1) match1))) (when haskell-process-suggest-hoogle-imports (let ((modules (haskell-process-hoogle-ident ident))) (haskell-process-suggest-imports session file modules ident))) (when haskell-process-suggest-haskell-docs-imports (let ((modules (haskell-process-haskell-docs-ident ident))) (haskell-process-suggest-imports session file modules ident))) (when haskell-process-suggest-hayoo-imports (let ((modules (haskell-process-hayoo-ident ident))) (haskell-process-suggest-imports session file modules ident))))) ((string-match "^[ ]+It is a member of the hidden package [‘`‛]\\(.+\\)['’].$" msg) (when haskell-process-suggest-add-package (haskell-process-suggest-add-package session msg))))) (defun haskell-process-do-cabal (command) "Run a Cabal command." (let ((process (haskell-interactive-process))) (cond ((let ((child (haskell-process-process process))) (not (equal 'run (process-status child)))) (message "Process is not running, so running directly.") (shell-command (concat "cabal " command) (get-buffer-create "*haskell-process-log*") (get-buffer-create "*haskell-process-log*")) (switch-to-buffer-other-window (get-buffer "*haskell-process-log*"))) (t (haskell-process-queue-command process (make-haskell-command :state (list (haskell-interactive-session) process command 0) :go (lambda (state) (haskell-process-send-string (cadr state) (format haskell-process-do-cabal-format-string (haskell-session-cabal-dir (car state)) (format "%s %s" (cl-ecase (haskell-process-type) ('ghci haskell-process-path-cabal) ('cabal-repl haskell-process-path-cabal) ('cabal-ghci haskell-process-path-cabal)) (cl-caddr state))))) :live (lambda (state buffer) (let ((cmd (replace-regexp-in-string "^\\([a-z]+\\).*" "\\1" (cl-caddr state)))) (cond ((or (string= cmd "build") (string= cmd "install")) (haskell-process-live-build (cadr state) buffer t)) (t (haskell-process-cabal-live state buffer))))) :complete (lambda (state response) (let* ((process (cadr state)) (session (haskell-process-session process)) (message-count 0) (cursor (haskell-process-response-cursor process))) (haskell-process-set-response-cursor process 0) (while (haskell-process-errors-warnings session process response) (setq message-count (1+ message-count))) (haskell-process-set-response-cursor process cursor) (let ((msg (format "Complete: cabal %s (%s compiler messages)" (cl-caddr state) message-count))) (haskell-interactive-mode-echo session msg) (when (= message-count 0) (haskell-interactive-mode-echo session "No compiler messages, dumping complete output:") (haskell-interactive-mode-echo session response)) (haskell-mode-message-line msg) (when (and haskell-notify-p (fboundp 'notifications-notify)) (notifications-notify :title (format "*%s*" (haskell-session-name (car state))) :body msg :app-name (cl-ecase (haskell-process-type) ('ghci haskell-process-path-cabal) ('cabal-repl haskell-process-path-cabal) ('cabal-ghci haskell-process-path-cabal)) :app-icon haskell-process-logo))))))))))) (defun haskell-process-echo-load-message (process buffer echo-in-repl th) "Echo a load message." (let ((session (haskell-process-session process)) (module-name (match-string 3 buffer)) (file-name (match-string 4 buffer))) (haskell-interactive-show-load-message session 'compiling module-name (haskell-session-strip-dir session file-name) echo-in-repl th))) (defun haskell-process-extract-modules (buffer) "Extract the modules from the process buffer." (let* ((modules-string (match-string 1 buffer)) (modules (split-string modules-string ", "))) (cons modules modules-string))) (defun haskell-process-errors-warnings (session process buffer &optional return-only) "Trigger handling type errors or warnings. Either prints the messages in the interactive buffer or if CONT is specified, passes the error onto that." (cond ((haskell-process-consume process "\\(Module imports form a cycle:[ \n]+module [^ ]+ ([^)]+)[[:unibyte:][:nonascii:]]+?\\)\nFailed") (let ((err (match-string 1 buffer))) (if (string-match "module [`'‘‛]\\([^ ]+\\)['’`] (\\([^)]+\\))" err) (let* ((default-directory (haskell-session-current-dir session)) (module (match-string 1 err)) (file (match-string 2 err)) (relative-file-name (file-relative-name file))) (unless return-only (haskell-interactive-show-load-message session 'import-cycle module relative-file-name nil nil) (haskell-interactive-mode-compile-error session (format "%s:1:0: %s" relative-file-name err))) (list :file file :line 1 :col 0 :msg err :type 'error)) t))) ((haskell-process-consume process (concat "[\r\n]\\([A-Z]?:?[^ \r\n:][^:\n\r]+\\):\\([0-9()-:]+\\):" "[ \n\r]+\\([[:unibyte:][:nonascii:]]+?\\)\n[^ ]")) (haskell-process-set-response-cursor process (- (haskell-process-response-cursor process) 1)) (let* ((buffer (haskell-process-response process)) (file (match-string 1 buffer)) (location (match-string 2 buffer)) (error-msg (match-string 3 buffer)) (warning (string-match "^Warning:" error-msg)) (splice (string-match "^Splicing " error-msg)) (final-msg (format "%s:%s: %s" (haskell-session-strip-dir session file) location error-msg))) (if return-only (let* ((location (haskell-process-parse-error (concat file ":" location ": x"))) (file (plist-get location :file)) (line (plist-get location :line)) (col1 (plist-get location :col))) (list :file file :line line :col col1 :msg error-msg :type (if warning 'warning 'error))) (progn (funcall (cond (warning 'haskell-interactive-mode-compile-warning) (splice 'haskell-interactive-mode-compile-splice) (t 'haskell-interactive-mode-compile-error)) session final-msg) (unless warning (haskell-mode-message-line final-msg)) (haskell-process-trigger-suggestions session error-msg file (plist-get (haskell-process-parse-error final-msg) :line)) t)))))) (defun haskell-interactive-show-load-message (session type module-name file-name echo th) "Show the '(Compiling|Loading) X' message." (let ((msg (concat (cl-ecase type ('compiling (if haskell-interactive-mode-include-file-name (format "Compiling: %s (%s)" module-name file-name) (format "Compiling: %s" module-name))) ('loading (format "Loading: %s" module-name)) ('import-cycle (format "Module has an import cycle: %s" module-name))) (if th " [TH]" "")))) (haskell-mode-message-line msg) (when haskell-interactive-mode-delete-superseded-errors (haskell-interactive-mode-delete-compile-messages session file-name)) (when echo (haskell-interactive-mode-echo session msg)))) ;;;###autoload (defun haskell-process-reload-devel-main () "Reload the module `DevelMain' and then run `DevelMain.update'. This is for doing live update of the code of servers or GUI applications. Put your development version of the program in `DevelMain', and define `update' to auto-start the program on a new thread, and use the `foreign-store' package to access the running context across :load/:reloads in GHCi." (interactive) (with-current-buffer (or (get-buffer "DevelMain.hs") (if (y-or-n-p "You need to open a buffer named DevelMain.hs. Find now?") (ido-find-file) (error "No DevelMain.hs buffer."))) (let ((session (haskell-interactive-session))) (let ((process (haskell-interactive-process))) (haskell-process-queue-command process (make-haskell-command :state (list :session session :process process :buffer (current-buffer)) :go (lambda (state) (haskell-process-send-string (plist-get state ':process) ":l DevelMain")) :live (lambda (state buffer) (haskell-process-live-build (plist-get state ':process) buffer nil)) :complete (lambda (state response) (haskell-process-load-complete (plist-get state ':session) (plist-get state ':process) response nil (plist-get state ':buffer) (lambda (ok) (when ok (haskell-process-queue-without-filters (haskell-interactive-process) "DevelMain.update") (message "DevelMain updated."))))))))))) (provide 'haskell-load) haskell-mode-13.14.2/haskell-menu.el000066400000000000000000000145511253441665600171600ustar00rootroot00000000000000;;; haskell-menu.el --- A Haskell sessions menu ;; Copyright (C) 2013 Chris Done ;; Author: Chris Done ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;;; Todo: ;;; Code: (require 'cl-lib) (require 'haskell-compat) (require 'haskell-session) (require 'haskell-process) (require 'haskell-interactive-mode) (defcustom haskell-menu-buffer-name "*haskell-menu*" "The name of the Haskell session menu buffer" :group 'haskell-interactive :type 'string) ;;;###autoload (defun haskell-menu () "Launch the Haskell sessions menu." (interactive) (or (get-buffer haskell-menu-buffer-name) (with-current-buffer (get-buffer-create haskell-menu-buffer-name) (haskell-menu-mode))) (switch-to-buffer-other-window (get-buffer haskell-menu-buffer-name)) (haskell-menu-revert-function nil nil)) (define-derived-mode haskell-menu-mode special-mode "Haskell Session Menu" "Major mode for managing Haskell sessions. Each line describes one session. Letters do not insert themselves; instead, they are commands." (setq buffer-read-only t) (set (make-local-variable 'revert-buffer-function) 'haskell-menu-revert-function) (setq truncate-lines t) (haskell-menu-revert-function nil t)) (suppress-keymap haskell-menu-mode-map t) (define-key haskell-menu-mode-map (kbd "n") 'next-line) (define-key haskell-menu-mode-map (kbd "p") 'previous-line) (define-key haskell-menu-mode-map (kbd "RET") 'haskell-menu-mode-ret) (defun haskell-menu-revert-function (arg1 arg2) "Function to refresh the display." (let ((buffer-read-only nil) (orig-line (line-number-at-pos)) (orig-col (current-column))) (or (eq buffer-undo-list t) (setq buffer-undo-list nil)) (erase-buffer) (haskell-menu-insert-menu) (goto-char (point-min)) (forward-line (1- orig-line)) (forward-char orig-col))) (defun haskell-menu-insert-menu () "Insert the Haskell sessions menu to the current buffer." (if (null haskell-sessions) (insert "No Haskell sessions.") (haskell-menu-tabulate (list "Name" "PID" "Time" "RSS" "Cabal directory" "Working directory" "Command") (mapcar (lambda (session) (let ((process (haskell-process-process (haskell-session-process session)))) (cond (process (let ((id (process-id process))) (list (propertize (haskell-session-name session) 'face 'buffer-menu-buffer) (if (process-live-p process) (number-to-string id) "-") (if (process-live-p process) (format-time-string "%H:%M:%S" (encode-time (cl-caddr (assoc 'etime (process-attributes id))) 0 0 0 0 0)) "-") (if (process-live-p process) (concat (number-to-string (/ (cdr (assoc 'rss (process-attributes id))) 1024)) "MB") "-") (haskell-session-cabal-dir session) (haskell-session-current-dir session) (mapconcat 'identity (process-command process) " ")))) (t (list (propertize (haskell-session-name session) 'face 'buffer-menu-buffer) "—" "—" "—" (haskell-session-cabal-dir session) (haskell-session-current-dir session)))))) haskell-sessions)))) (defun haskell-menu-tabulate (headings rows) "Prints a list of lists as a formatted table to the current buffer." (let* ((columns (length headings)) (widths (make-list columns 0))) ;; Calculate column widths. This is kind of hideous. (dolist (row rows) (setq widths (let ((list (list))) (dotimes (i columns) (setq list (cons (max (nth i widths) (1+ (length (nth i row))) (1+ (length (nth i headings)))) list))) (reverse list)))) ;; Print headings. (let ((heading (propertize " " 'display '(space :align-to 0)))) (dotimes (i columns) (setq heading (concat heading (format (concat "%-" (number-to-string (nth i widths)) "s") (nth i headings))))) (setq header-line-format heading)) ;; Print tabulated rows. (dolist (row rows) (dotimes (i columns) (insert (format (concat "%-" (number-to-string (nth i widths)) "s") (nth i row)))) (insert "\n")))) (defun haskell-menu-mode-ret () "Handle RET key." (interactive) (let* ((name (save-excursion (goto-char (line-beginning-position)) (buffer-substring-no-properties (point) (progn (search-forward " ") (forward-char -1) (point))))) (session (car (cl-remove-if-not (lambda (session) (string= (haskell-session-name session) name)) haskell-sessions)))) (switch-to-buffer (haskell-session-interactive-buffer session)))) (provide 'haskell-menu) ;;; haskell-menu.el ends here haskell-mode-13.14.2/haskell-mode-pkg.el000066400000000000000000000001271253441665600177110ustar00rootroot00000000000000(define-package "haskell-mode" "13.14.2" "A Haskell editing mode" '((cl-lib "0.5"))) haskell-mode-13.14.2/haskell-mode.el000066400000000000000000001270511253441665600171400ustar00rootroot00000000000000;;; haskell-mode.el --- A Haskell editing mode -*- coding: utf-8 -*- ;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc ;; Copyright (C) 1992, 1997-1998 Simon Marlow, Graeme E Moss, and Tommy Thorn ;; Author: 1992 Simon Marlow ;; 1997-1998 Graeme E Moss and ;; Tommy Thorn , ;; 2001-2002 Reuben Thomas (>=v1.4) ;; 2003 Dave Love ;; Keywords: faces files Haskell ;; Version: 13.14.2 ;; URL: https://github.com/haskell/haskell-mode ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; A major mode for editing Haskell (the functional programming ;; language, see URL `http://www.haskell.org') in Emacs. ;; ;; Some of its major features include: ;; ;; - syntax highlighting (font lock), ;; ;; - automatic indentation, ;; ;; - on-the-fly documentation, ;; ;; - interaction with inferior GHCi/Hugs instance, ;; ;; - scans declarations and places them in a menu. ;; ;; See URL `https://github.com/haskell/haskell-mode' and/or ;; Info node `(haskell-mode)Introduction' for more information. ;; ;; Use `M-x haskell-mode-view-news` (after Haskell Mode is installed) ;; to show information on recent changes in Haskell Mode. ;;; Change Log: ;; This mode is based on an editing mode by Simon Marlow 11/1/92 ;; and heavily modified by Graeme E Moss and Tommy Thorn 7/11/98. ;; ;; Version 1.5: ;; Added autoload for haskell-indentation ;; ;; Version 1.43: ;; Various tweaks to doc strings and customization support from ;; Ville Skyttä . ;; ;; Version 1.42: ;; Added autoload for GHCi inferior mode (thanks to Scott ;; Williams for the bug report and fix). ;; ;; Version 1.41: ;; Improved packaging, and made a couple more variables ;; interactively settable. ;; ;; Version 1.4: ;; Added GHCi mode from Chris Webb, and tidied up a little. ;; ;; Version 1.3: ;; The literate or non-literate style of a buffer is now indicated ;; by just the variable haskell-literate: nil, `bird', or `tex'. ;; For literate buffers with ambiguous style, the value of ;; haskell-literate-default is used. ;; ;; Version 1.2: ;; Separated off font locking, declaration scanning and simple ;; indentation, and made them separate modules. Modules can be ;; added easily now. Support for modules haskell-doc, ;; haskell-indent, and haskell-hugs. Literate and non-literate ;; modes integrated into one mode, and literate buffer indicated by ;; value of haskell-literate(-bird-style). ;; ;; Version 1.1: ;; Added support for declaration scanning under XEmacs via ;; func-menu. Moved operators to level two fontification. ;; ;; Version 1.0: ;; Added a nice indention support from Heribert Schuetz ;; : ;; ;; I have just hacked an Emacs Lisp function which you might prefer ;; to `indent-relative' in haskell-mode.el. See below. It is not ;; really Haskell-specific because it does not take into account ;; keywords like `do', `of', and `let' (where the layout rule ;; applies), but I already find it useful. ;; ;; Cleaned up the imenu support. Added support for literate scripts. ;; ;; Version 0.103 [HWL]: ;; From Hans Wolfgang Loidl : ;; ;; I (HWL) added imenu support by copying the appropriate functions ;; from hugs-mode. A menu-bar item "Declarations" is now added in ;; haskell mode. The new code, however, needs some clean-up. ;; ;; Version 0.102: ;; ;; Moved C-c C-c key binding to comment-region. Leave M-g M-g to do ;; the work. comment-start-skip is changed to comply with comment-start. ;; ;; Version 0.101: ;; ;; Altered indent-line-function to indent-relative. ;; ;; Version 0.100: ;; ;; First official release. ;;; Code: (require 'haskell-customize) (require 'ansi-color) (require 'dabbrev) (require 'compile) (require 'etags) (require 'flymake) (require 'outline) (require 'cl-lib) (require 'haskell-complete-module) (require 'haskell-compat) (require 'haskell-align-imports) (require 'haskell-sort-imports) (require 'haskell-string) ;; All functions/variables start with `(literate-)haskell-'. ;; Version of mode. (defconst haskell-version "13.14" "The release version of `haskell-mode'.") ;;;###autoload (defun haskell-version (&optional here) "Show the `haskell-mode` version in the echo area. With prefix argument HERE, insert it at point." (interactive "P") (let* ((haskell-mode-dir (ignore-errors (file-name-directory (or (locate-library "haskell-mode") "")))) (_version (format "haskell-mode version %s (%s)" haskell-version haskell-mode-dir))) (if here (insert _version) (message "%s" _version)))) ;;;###autoload (defun haskell-mode-view-news () "Display information on recent changes to haskell-mode." (interactive) (with-current-buffer (find-file-read-only (expand-file-name "NEWS" haskell-mode-pkg-base-dir)) (goto-char (point-min)) (outline-hide-sublevels 1) (outline-next-visible-heading 1) (outline-show-subtree))) ;; Are we looking at a literate script? (defvar haskell-literate nil "*If not nil, the current buffer contains a literate Haskell script. Possible values are: `bird' and `tex', for Bird-style and LaTeX-style literate scripts respectively. Set by `haskell-mode' and `literate-haskell-mode'. For an ambiguous literate buffer -- i.e. does not contain either \"\\begin{code}\" or \"\\end{code}\" on a line on its own, nor does it contain \">\" at the start of a line -- the value of `haskell-literate-default' is used.") (make-variable-buffer-local 'haskell-literate) (put 'haskell-literate 'safe-local-variable 'symbolp) ;; Default literate style for ambiguous literate buffers. (defcustom haskell-literate-default 'bird "Default value for `haskell-literate'. Used if the style of a literate buffer is ambiguous. This variable should be set to the preferred literate style." :group 'haskell :type '(choice (const bird) (const tex) (const nil))) (defvar haskell-mode-map (let ((map (make-sparse-keymap))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Editing-specific commands (define-key map (kbd "C-c C-.") 'haskell-mode-format-imports) (define-key map [remap delete-indentation] 'haskell-delete-indentation) (define-key map (kbd "C-c C-l") 'haskell-mode-enable-process-minor-mode) (define-key map (kbd "C-c C-b") 'haskell-mode-enable-process-minor-mode) (define-key map (kbd "C-c C-v") 'haskell-mode-enable-process-minor-mode) (define-key map (kbd "C-c C-t") 'haskell-mode-enable-process-minor-mode) (define-key map (kbd "C-c C-i") 'haskell-mode-enable-process-minor-mode) map) "Keymap used in Haskell mode.") (defun haskell-mode-enable-process-minor-mode () "Tell the user to choose a minor mode for process interaction." (interactive) (error "Run `C-h f haskell-mode` for instruction how to setup a Haskell interaction mode.")) (easy-menu-define haskell-mode-menu haskell-mode-map "Menu for the Haskell major mode." ;; Suggestions from Pupeno : ;; - choose the underlying interpreter ;; - look up docs `("Haskell" ["Indent line" indent-according-to-mode] ["Indent region" indent-region mark-active] ["(Un)Comment region" comment-region mark-active] "---" ["Start interpreter" haskell-interactive-switch] ["Load file" haskell-process-load-file] "---" ["Load tidy core" ghc-core-create-core] "---" ,(if (default-boundp 'eldoc-documentation-function) ["Doc mode" eldoc-mode :style toggle :selected (bound-and-true-p eldoc-mode)] ["Doc mode" haskell-doc-mode :style toggle :selected (and (boundp 'haskell-doc-mode) haskell-doc-mode)]) ["Customize" (customize-group 'haskell)] )) ;; Procedurally generated (see Lexeme.hs in ghc). ;; This is a bit unsightly: it's generated by making a list of all ;; unicode characters whose Unicode general category ghc would ;; recognize as valid symbol (or identifier, below) constituent. (defvar haskell--char-syntax-symbols '((161 . 169) 172 (174 . 177) 180 (182 . 184) 191 215 247 (706 . 709) (722 . 735) (741 . 747) 749 (751 . 767) 885 894 (900 . 901) 903 1014 1154 (1370 . 1375) (1417 . 1418) (1421 . 1423) 1470 1472 1475 1478 (1523 . 1524) (1542 . 1551) 1563 (1566 . 1567) (1642 . 1645) 1748 1758 1769 (1789 . 1790) (1792 . 1805) (2038 . 2041) (2096 . 2110) 2142 (2404 . 2405) 2416 (2546 . 2547) (2554 . 2555) (2800 . 2801) 2928 (3059 . 3066) 3199 3449 3572 3647 3663 (3674 . 3675) (3841 . 3863) (3866 . 3871) 3892 3894 3896 3973 (4030 . 4037) (4039 . 4044) (4046 . 4058) (4170 . 4175) (4254 . 4255) 4347 (4960 . 4968) (5008 . 5017) 5120 (5741 . 5742) (5867 . 5869) (5941 . 5942) (6100 . 6102) (6104 . 6107) (6144 . 6154) 6464 (6468 . 6469) (6622 . 6623) (6624 . 6655) (6686 . 6687) (6816 . 6822) (6824 . 6829) (7002 . 7018) (7028 . 7036) (7164 . 7167) (7227 . 7231) (7294 . 7295) (7360 . 7367) 7379 8125 (8127 . 8129) (8141 . 8143) (8157 . 8159) (8173 . 8175) (8189 . 8190) (8208 . 8215) (8224 . 8231) (8240 . 8248) (8251 . 8260) (8263 . 8286) (8314 . 8316) (8330 . 8332) (8352 . 8381) (8448 . 8449) (8451 . 8454) (8456 . 8457) 8468 (8470 . 8472) (8478 . 8483) 8485 8487 8489 8494 (8506 . 8507) (8512 . 8516) (8522 . 8525) 8527 (8592 . 8703) (8704 . 8959) (8960 . 8967) (8972 . 9000) (9003 . 9210) (9216 . 9254) (9280 . 9290) (9372 . 9449) (9472 . 9599) (9600 . 9631) (9632 . 9727) (9728 . 9983) (9984 . 10087) (10132 . 10175) (10176 . 10180) (10183 . 10213) (10224 . 10239) (10240 . 10495) (10496 . 10623) (10624 . 10626) (10649 . 10711) (10716 . 10747) (10750 . 10751) (10752 . 11007) (11008 . 11123) (11126 . 11157) (11160 . 11193) (11197 . 11208) (11210 . 11217) (11493 . 11498) (11513 . 11516) (11518 . 11519) 11632 (11776 . 11777) (11782 . 11784) 11787 (11790 . 11803) (11806 . 11807) (11818 . 11822) (11824 . 11841) (11904 . 11929) (11931 . 12019) (12032 . 12245) (12272 . 12283) (12289 . 12292) (12306 . 12307) 12316 12320 12336 (12342 . 12343) (12349 . 12351) (12443 . 12444) 12448 12539 (12688 . 12689) (12694 . 12703) (12736 . 12771) (12800 . 12830) (12842 . 12871) 12880 (12896 . 12927) (12938 . 12976) (12992 . 13054) (13056 . 13311) (19904 . 19967) (42128 . 42182) (42238 . 42239) (42509 . 42511) 42611 42622 (42738 . 42743) (42752 . 42774) (42784 . 42785) (42889 . 42890) (43048 . 43051) (43062 . 43065) (43124 . 43127) (43214 . 43215) (43256 . 43258) (43310 . 43311) 43359 (43457 . 43469) (43486 . 43487) (43612 . 43615) (43639 . 43641) (43742 . 43743) (43760 . 43761) 43867 44011 64297 (64434 . 64449) (65020 . 65021) (65040 . 65046) 65049 (65072 . 65076) (65093 . 65094) (65097 . 65103) (65104 . 65106) (65108 . 65112) (65119 . 65126) (65128 . 65131) (65281 . 65287) (65290 . 65295) (65306 . 65312) 65340 (65342 . 65344) 65372 65374 65377 (65380 . 65381) (65504 . 65510) (65512 . 65518) (65532 . 65533) (65792 . 65794) (65847 . 65855) (65913 . 65929) 65932 (65936 . 65947) 65952 (66000 . 66044) 66463 66512 66927 67671 (67703 . 67704) 67871 67903 (68176 . 68184) 68223 68296 (68336 . 68342) (68409 . 68415) (68505 . 68508) (69703 . 69709) (69819 . 69820) (69822 . 69825) (69952 . 69955) (70004 . 70005) (70085 . 70088) 70093 (70200 . 70205) 70854 (71105 . 71113) (71233 . 71235) (74864 . 74868) (92782 . 92783) 92917 (92983 . 92991) (92996 . 92997) 113820 113823 (118784 . 119029) (119040 . 119078) (119081 . 119140) (119146 . 119148) (119171 . 119172) (119180 . 119209) (119214 . 119261) (119296 . 119361) 119365 (119552 . 119638) 120513 120539 120571 120597 120629 120655 120687 120713 120745 120771 (126704 . 126705) (126976 . 127019) (127024 . 127123) (127136 . 127150) (127153 . 127167) (127169 . 127183) (127185 . 127221) (127248 . 127278) (127280 . 127339) (127344 . 127386) (127462 . 127487) (127488 . 127490) (127504 . 127546) (127552 . 127560) (127568 . 127569) (127744 . 127788) (127792 . 127869) (127872 . 127950) (127956 . 127991) (128000 . 128254) (128256 . 128330) (128336 . 128377) (128379 . 128419) (128421 . 128511) (128512 . 128578) (128581 . 128591) (128592 . 128639) (128640 . 128719) (128736 . 128748) (128752 . 128755) (128768 . 128883) (128896 . 128980) (129024 . 129035) (129040 . 129095) (129104 . 129113) (129120 . 129159) (129168 . 129197))) (defvar haskell--char-syntax-identifiers '(170 (178 . 179) 181 (185 . 186) (188 . 190) (192 . 214) (216 . 246) (248 . 255) (256 . 383) (384 . 591) (592 . 687) (880 . 883) (886 . 887) (891 . 893) 895 902 (904 . 906) 908 (910 . 929) (931 . 1013) (1015 . 1023) (1024 . 1153) (1162 . 1279) (1280 . 1327) (1329 . 1366) (1377 . 1415) (1488 . 1514) (1520 . 1522) (1568 . 1599) (1601 . 1610) (1632 . 1641) (1646 . 1647) (1649 . 1747) 1749 (1774 . 1788) 1791 1808 (1810 . 1839) (1869 . 1871) (1872 . 1919) (1920 . 1957) 1969 (1984 . 2026) (2048 . 2069) (2112 . 2136) (2208 . 2226) (2308 . 2361) 2365 2384 (2392 . 2401) (2406 . 2415) (2418 . 2431) 2432 (2437 . 2444) (2447 . 2448) (2451 . 2472) (2474 . 2480) 2482 (2486 . 2489) 2493 2510 (2524 . 2525) (2527 . 2529) (2534 . 2545) (2548 . 2553) (2565 . 2570) (2575 . 2576) (2579 . 2600) (2602 . 2608) (2610 . 2611) (2613 . 2614) (2616 . 2617) (2649 . 2652) 2654 (2662 . 2671) (2674 . 2676) (2693 . 2701) (2703 . 2705) (2707 . 2728) (2730 . 2736) (2738 . 2739) (2741 . 2745) 2749 2768 (2784 . 2785) (2790 . 2799) (2821 . 2828) (2831 . 2832) (2835 . 2856) (2858 . 2864) (2866 . 2867) (2869 . 2873) 2877 (2908 . 2909) (2911 . 2913) (2918 . 2927) (2929 . 2935) 2947 (2949 . 2954) (2958 . 2960) (2962 . 2965) (2969 . 2970) 2972 (2974 . 2975) (2979 . 2980) (2984 . 2986) (2990 . 3001) 3024 (3046 . 3058) (3077 . 3084) (3086 . 3088) (3090 . 3112) (3114 . 3129) 3133 (3160 . 3161) (3168 . 3169) (3174 . 3183) (3192 . 3198) (3205 . 3212) (3214 . 3216) (3218 . 3240) (3242 . 3251) (3253 . 3257) 3261 3294 (3296 . 3297) (3302 . 3311) (3313 . 3314) (3333 . 3340) (3342 . 3344) (3346 . 3386) 3389 3406 (3424 . 3425) (3430 . 3445) (3450 . 3455) (3461 . 3478) (3482 . 3505) (3507 . 3515) 3517 (3520 . 3526) (3558 . 3567) (3585 . 3632) (3634 . 3635) (3648 . 3653) (3664 . 3673) (3713 . 3714) 3716 (3719 . 3720) 3722 3725 (3732 . 3735) (3737 . 3743) (3745 . 3747) 3749 3751 (3754 . 3755) (3757 . 3760) (3762 . 3763) 3773 (3776 . 3780) (3792 . 3801) (3804 . 3807) 3840 (3872 . 3891) (3904 . 3911) (3913 . 3948) (3976 . 3980) (4096 . 4138) (4159 . 4169) (4176 . 4181) (4186 . 4189) 4193 (4197 . 4198) (4206 . 4208) (4213 . 4225) 4238 (4240 . 4249) (4256 . 4293) 4295 4301 (4304 . 4346) (4349 . 4351) (4352 . 4607) (4608 . 4680) (4682 . 4685) (4688 . 4694) 4696 (4698 . 4701) (4704 . 4744) (4746 . 4749) (4752 . 4784) (4786 . 4789) (4792 . 4798) 4800 (4802 . 4805) (4808 . 4822) (4824 . 4880) (4882 . 4885) (4888 . 4954) (4969 . 4988) (4992 . 5007) (5024 . 5108) (5121 . 5740) (5743 . 5759) (5761 . 5786) (5792 . 5866) (5873 . 5880) (5888 . 5900) (5902 . 5905) (5920 . 5937) (5952 . 5969) (5984 . 5996) (5998 . 6000) (6016 . 6067) 6108 (6112 . 6121) (6128 . 6137) (6160 . 6169) (6176 . 6210) (6212 . 6263) (6272 . 6312) 6314 (6320 . 6389) (6400 . 6430) (6470 . 6479) (6480 . 6509) (6512 . 6516) (6528 . 6571) (6593 . 6599) (6608 . 6618) (6656 . 6678) (6688 . 6740) (6784 . 6793) (6800 . 6809) (6917 . 6963) (6981 . 6987) (6992 . 7001) (7043 . 7072) (7086 . 7103) (7104 . 7141) (7168 . 7203) (7232 . 7241) (7245 . 7247) (7248 . 7287) (7401 . 7404) (7406 . 7409) (7413 . 7414) (7424 . 7467) (7531 . 7543) (7545 . 7551) (7552 . 7578) (7680 . 7935) (7936 . 7957) (7960 . 7965) (7968 . 8005) (8008 . 8013) (8016 . 8023) 8025 8027 8029 (8031 . 8061) (8064 . 8116) (8118 . 8124) 8126 (8130 . 8132) (8134 . 8140) (8144 . 8147) (8150 . 8155) (8160 . 8172) (8178 . 8180) (8182 . 8188) 8304 (8308 . 8313) (8320 . 8329) 8450 8455 (8458 . 8467) 8469 (8473 . 8477) 8484 8486 8488 (8490 . 8493) (8495 . 8505) (8508 . 8511) (8517 . 8521) 8526 (8528 . 8543) (8579 . 8580) 8585 (9312 . 9371) (9450 . 9471) (10102 . 10131) (11264 . 11310) (11312 . 11358) (11360 . 11387) (11390 . 11391) (11392 . 11492) (11499 . 11502) (11506 . 11507) 11517 (11520 . 11557) 11559 11565 (11568 . 11623) (11648 . 11670) (11680 . 11686) (11688 . 11694) (11696 . 11702) (11704 . 11710) (11712 . 11718) (11720 . 11726) (11728 . 11734) (11736 . 11742) 12294 12348 (12353 . 12438) 12447 (12449 . 12538) 12543 (12549 . 12589) (12593 . 12686) (12690 . 12693) (12704 . 12730) (12784 . 12799) (12832 . 12841) (12872 . 12879) (12881 . 12895) (12928 . 12937) (12977 . 12991) (13312 . 19893) (19968 . 40908) (40960 . 40980) (40982 . 42124) (42192 . 42231) (42240 . 42507) (42512 . 42539) (42560 . 42606) (42624 . 42651) (42656 . 42725) (42786 . 42863) (42865 . 42887) (42891 . 42894) (42896 . 42925) (42928 . 42929) 42999 (43002 . 43007) (43008 . 43009) (43011 . 43013) (43015 . 43018) (43020 . 43042) (43056 . 43061) (43072 . 43123) (43138 . 43187) (43216 . 43225) (43250 . 43255) 43259 (43264 . 43301) (43312 . 43334) (43360 . 43388) (43396 . 43442) (43472 . 43481) (43488 . 43492) (43495 . 43518) (43520 . 43560) (43584 . 43586) (43588 . 43595) (43600 . 43609) (43616 . 43631) (43633 . 43638) 43642 (43646 . 43647) (43648 . 43695) 43697 (43701 . 43702) (43705 . 43709) 43712 43714 (43739 . 43740) (43744 . 43754) 43762 (43777 . 43782) (43785 . 43790) (43793 . 43798) (43808 . 43814) (43816 . 43822) (43824 . 43866) (43876 . 43877) (43968 . 44002) (44016 . 44025) (44032 . 55203) (55216 . 55238) (55243 . 55291) (63744 . 64109) (64112 . 64217) (64256 . 64262) (64275 . 64279) 64285 (64287 . 64296) (64298 . 64310) (64312 . 64316) 64318 (64320 . 64321) (64323 . 64324) (64326 . 64335) (64336 . 64433) (64467 . 64829) (64848 . 64911) (64914 . 64967) (65008 . 65019) (65136 . 65140) (65142 . 65276) (65296 . 65305) (65313 . 65338) (65345 . 65370) (65382 . 65391) (65393 . 65437) (65440 . 65470) (65474 . 65479) (65482 . 65487) (65490 . 65495) (65498 . 65500) (65536 . 65547) (65549 . 65574) (65576 . 65594) (65596 . 65597) (65599 . 65613) (65616 . 65629) (65664 . 65786) (65799 . 65843) (65909 . 65912) (65930 . 65931) (66176 . 66204) (66208 . 66256) (66273 . 66299) (66304 . 66339) (66352 . 66368) (66370 . 66377) (66384 . 66421) (66432 . 66461) (66464 . 66499) (66504 . 66511) (66560 . 66639) (66640 . 66687) (66688 . 66717) (66720 . 66729) (66816 . 66855) (66864 . 66915) (67072 . 67382) (67392 . 67413) (67424 . 67431) (67584 . 67589) 67592 (67594 . 67637) (67639 . 67640) 67644 67647 (67648 . 67669) (67672 . 67679) (67680 . 67702) (67705 . 67711) (67712 . 67742) (67751 . 67759) (67840 . 67867) (67872 . 67897) (67968 . 67999) (68000 . 68023) (68030 . 68031) 68096 (68112 . 68115) (68117 . 68119) (68121 . 68147) (68160 . 68167) (68192 . 68222) (68224 . 68255) (68288 . 68295) (68297 . 68324) (68331 . 68335) (68352 . 68405) (68416 . 68437) (68440 . 68447) (68448 . 68466) (68472 . 68479) (68480 . 68497) (68521 . 68527) (68608 . 68680) (69216 . 69246) (69635 . 69687) (69714 . 69743) (69763 . 69807) (69840 . 69864) (69872 . 69881) (69891 . 69926) (69942 . 69951) (69968 . 70002) 70006 (70019 . 70066) (70081 . 70084) (70096 . 70106) (70113 . 70132) (70144 . 70161) (70163 . 70187) (70320 . 70366) (70384 . 70393) (70405 . 70412) (70415 . 70416) (70419 . 70440) (70442 . 70448) (70450 . 70451) (70453 . 70457) 70461 (70493 . 70497) (70784 . 70831) (70852 . 70853) 70855 (70864 . 70873) (71040 . 71086) (71168 . 71215) 71236 (71248 . 71257) (71296 . 71338) (71360 . 71369) (71840 . 71922) 71935 (72384 . 72440) (73728 . 74648) (77824 . 78894) (92160 . 92728) (92736 . 92766) (92768 . 92777) (92880 . 92909) (92928 . 92975) (93008 . 93017) (93019 . 93025) (93027 . 93047) (93053 . 93071) (93952 . 94020) 94032 (110592 . 110593) (113664 . 113770) (113776 . 113788) (113792 . 113800) (113808 . 113817) (119648 . 119665) (119808 . 119892) (119894 . 119964) (119966 . 119967) 119970 (119973 . 119974) (119977 . 119980) (119982 . 119993) 119995 (119997 . 120003) (120005 . 120069) (120071 . 120074) (120077 . 120084) (120086 . 120092) (120094 . 120121) (120123 . 120126) (120128 . 120132) 120134 (120138 . 120144) (120146 . 120485) (120488 . 120512) (120514 . 120538) (120540 . 120570) (120572 . 120596) (120598 . 120628) (120630 . 120654) (120656 . 120686) (120688 . 120712) (120714 . 120744) (120746 . 120770) (120772 . 120779) (120782 . 120831) (124928 . 125124) (125127 . 125135) (126464 . 126467) (126469 . 126495) (126497 . 126498) 126500 126503 (126505 . 126514) (126516 . 126519) 126521 126523 126530 126535 126537 126539 (126541 . 126543) (126545 . 126546) 126548 126551 126553 126555 126557 126559 (126561 . 126562) 126564 (126567 . 126570) (126572 . 126578) (126580 . 126583) (126585 . 126588) 126590 (126592 . 126601) (126603 . 126619) (126625 . 126627) (126629 . 126633) (126635 . 126651) (127232 . 127244) (131072 . 173782) (173824 . 177972) (177984 . 178205) (194560 . 195101))) ;; Syntax table. (defvar haskell-mode-syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?\ " " table) (modify-syntax-entry ?\t " " table) (modify-syntax-entry ?\" "\"" table) (modify-syntax-entry ?\' "_" table) (modify-syntax-entry ?_ "w" table) (modify-syntax-entry ?\( "()" table) (modify-syntax-entry ?\) ")(" table) (modify-syntax-entry ?\[ "(]" table) (modify-syntax-entry ?\] ")[" table) (modify-syntax-entry ?\{ "(}1nb" table) (modify-syntax-entry ?\} "){4nb" table) (modify-syntax-entry ?- ". 123" table) (modify-syntax-entry ?\n ">" table) (modify-syntax-entry ?\` "$`" table) (mapc (lambda (x) (modify-syntax-entry x "." table)) "!#$%&*+./:<=>?@^|~,;\\") ;; Haskell symbol characters are treated as punctuation because ;; they are not able to form identifiers with word constituent 'w' ;; class characters. (dolist (charcodes haskell--char-syntax-symbols) (modify-syntax-entry charcodes "." table)) ;; ... and for identifier characters (dolist (charcodes haskell--char-syntax-identifiers) (modify-syntax-entry charcodes "w" table)) table) "Syntax table used in Haskell mode.") (defun haskell-ident-at-point () "Return the identifier under point, or nil if none found. May return a qualified name." (let ((reg (haskell-ident-pos-at-point))) (when reg (buffer-substring-no-properties (car reg) (cdr reg))))) (defun haskell-spanable-pos-at-point () "Like `haskell-ident-pos-at-point', but includes any surrounding backticks." (save-excursion (let ((pos (haskell-ident-pos-at-point))) (when pos (cl-destructuring-bind (start . end) pos (if (and (eq ?` (char-before start)) (eq ?` (char-after end))) (cons (- start 1) (+ end 1)) (cons start end))))))) (defun haskell-ident-pos-at-point () "Return the span of the identifier under point, or nil if none found. May return a qualified name." (save-excursion ;; Skip whitespace if we're on it. That way, if we're at "map ", we'll ;; see the word "map". (if (and (not (eobp)) (eq ? (char-syntax (char-after)))) (skip-chars-backward " \t")) (let ((case-fold-search nil)) (cl-multiple-value-bind (start end) (list (progn (skip-syntax-backward "w_") (point)) (progn (skip-syntax-forward "w_") (point))) ;; If we're looking at a module ID that qualifies further IDs, add ;; those IDs. (goto-char start) (while (and (looking-at "[[:upper:]]") (eq (char-after end) ?.) ;; It's a module ID that qualifies further IDs. (goto-char (1+ end)) (save-excursion (when (not (zerop (skip-syntax-forward (if (looking-at "\\s_") "_" "w'")))) (setq end (point)))))) ;; If we're looking at an ID that's itself qualified by previous ;; module IDs, add those too. (goto-char start) (if (eq (char-after) ?.) (forward-char 1)) ;Special case for "." (while (and (eq (char-before) ?.) (progn (forward-char -1) (not (zerop (skip-syntax-backward "w'")))) (skip-syntax-forward "'") (looking-at "[[:upper:]]")) (setq start (point))) ;; This is it. (unless (= start end) (cons start end)))))) (defun haskell-delete-indentation (&optional arg) "Like `delete-indentation' but ignoring Bird-style \">\"." (interactive "*P") (let ((fill-prefix (or fill-prefix (if (eq haskell-literate 'bird) ">")))) (delete-indentation arg))) ;; Various mode variables. (defcustom haskell-mode-contextual-import-completion t "Enable import completion on haskell-mode-contextual-space." :type 'boolean :group 'haskell-interactive) (defvar eldoc-print-current-symbol-info-function) ;; For compatibility with Emacs < 24, derive conditionally (defalias 'haskell-parent-mode (if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode)) ;; The main mode functions ;;;###autoload (define-derived-mode haskell-mode haskell-parent-mode "Haskell" "Major mode for editing Haskell programs. For more information aee also Info node `(haskell-mode)Getting Started'. \\ Literate Haskell scripts are supported via `literate-haskell-mode'. The variable `haskell-literate' indicates the style of the script in the current buffer. See the documentation on this variable for more details. Use `haskell-version' to find out what version of Haskell mode you are currently using. Additional Haskell mode modules can be hooked in via `haskell-mode-hook'. Indentation modes: `haskell-indentation-mode', Kristof Bastiaensen, Gergely Risko Intelligent semi-automatic indentation Mk2 `haskell-indent-mode', Guy Lapalme Intelligent semi-automatic indentation. `haskell-simple-indent-mode', Graeme E Moss and Heribert Schuetz Simple indentation. Interaction modes: `interactive-haskell-mode' Interact with per-project GHCi processes through a REPL and directory-aware sessions. `inf-haskell-mode' Interact with a GHCi process using comint-mode. Deprecated. Other modes: `haskell-decl-scan-mode', Graeme E Moss Scans top-level declarations, and places them in a menu. `haskell-doc-mode', Hans-Wolfgang Loidl Echoes types of functions or syntax of keywords when the cursor is idle. To activate a minor-mode, simply run the interactive command. For example, `M-x haskell-doc-mode'. Run it again to disable it. To enable a mode for every haskell-mode buffer, add a hook in your Emacs configuration. To do that you can customize `haskell-mode-hook' or add lines to your .emacs file. For example, to enable `haskell-indent-mode' and `interactive-haskell-mode', use the following: (add-hook 'haskell-mode-hook 'haskell-indentation-mode) (add-hook 'haskell-mode-hook 'interactive-haskell-mode) For more details see Info node `(haskell-mode)haskell-mode-hook'. Warning: do not enable more than one of the above indentation modes. See Info node `(haskell-mode)indentation' for more details. Minor modes that work well with `haskell-mode': - `smerge-mode': show and work with diff3 conflict markers used by git, svn and other version control systems." :group 'haskell ;; paragraph-{start,separate} should treat comments as paragraphs as well. (set (make-local-variable 'paragraph-start) (concat " *{-\\| *-- |\\|" page-delimiter)) (set (make-local-variable 'paragraph-separate) (concat " *$\\| *-- |\\| *\\({-\\|-}\\) *$\\|" page-delimiter)) (set (make-local-variable 'fill-paragraph-function) 'haskell-fill-paragraph) ;; (set (make-local-variable 'adaptive-fill-function) 'haskell-adaptive-fill) (set (make-local-variable 'adaptive-fill-mode) nil) (set (make-local-variable 'comment-start) "-- ") (set (make-local-variable 'comment-padding) 0) (set (make-local-variable 'comment-start-skip) "[-{]-[ \t]*") (set (make-local-variable 'comment-end) "") (set (make-local-variable 'comment-end-skip) "[ \t]*\\(-}\\|\\s>\\)") (set (make-local-variable 'parse-sexp-ignore-comments) nil) (set (make-local-variable 'indent-line-function) 'haskell-mode-suggest-indent-choice) ;; Set things up for eldoc-mode. (set (make-local-variable 'eldoc-documentation-function) 'haskell-doc-current-info) ;; Set things up for imenu. (set (make-local-variable 'imenu-create-index-function) 'haskell-ds-create-imenu-index) ;; Set things up for font-lock. (set (make-local-variable 'font-lock-defaults) '(haskell-font-lock-choose-keywords nil nil ((?\' . "w") (?_ . "w")) nil (font-lock-syntactic-keywords . haskell-font-lock-choose-syntactic-keywords) (font-lock-syntactic-face-function . haskell-syntactic-face-function) ;; Get help from font-lock-syntactic-keywords. (parse-sexp-lookup-properties . t))) ;; Haskell's layout rules mean that TABs have to be handled with extra care. ;; The safer option is to avoid TABs. The second best is to make sure ;; TABs stops are 8 chars apart, as mandated by the Haskell Report. --Stef (set (make-local-variable 'indent-tabs-mode) nil) (set (make-local-variable 'tab-width) 8) ;; Haskell is not generally suitable for electric indentation, since ;; there is no unambiguously correct indent level for any given line. (when (boundp 'electric-indent-inhibit) (setq electric-indent-inhibit t)) ;; dynamic abbrev support: recognize Haskell identifiers ;; Haskell is case-sensitive language (set (make-local-variable 'dabbrev-case-fold-search) nil) (set (make-local-variable 'dabbrev-case-distinction) nil) (set (make-local-variable 'dabbrev-case-replace) nil) (set (make-local-variable 'dabbrev-abbrev-char-regexp) "\\sw\\|[.]") (setq haskell-literate nil) (add-hook 'before-save-hook 'haskell-mode-before-save-handler nil t) (add-hook 'after-save-hook 'haskell-mode-after-save-handler nil t) ) (defun haskell-fill-paragraph (justify) (save-excursion ;; Fill paragraph should only work in comments. ;; The -- comments are handled properly by default ;; The {- -} comments need some extra love. (let* ((syntax-values (syntax-ppss)) (comment-num (nth 4 syntax-values))) (cond ((eq t comment-num) ;; standard fill works wonders inside a non-nested comment (fill-comment-paragraph justify)) ((integerp comment-num) ;; we are in a nested comment. lets narrow to comment content ;; and use plain paragraph fill for that (let* ((comment-start-point (nth 8 syntax-values)) (comment-end-point (save-excursion (goto-char comment-start-point) (forward-sexp) ;; Find end of any comment even if forward-sexp ;; fails to find the right braces. (backward-char 3) (re-search-forward "[ \t]?-}" nil t) (match-beginning 0))) (fill-start (+ 2 comment-start-point)) (fill-end comment-end-point) (fill-paragraph-handle-comment nil)) (save-restriction (narrow-to-region fill-start fill-end) (fill-paragraph justify) ;; If no filling happens, whatever called us should not ;; continue with standard text filling, so return t t))) ((eolp) ;; do nothing outside of a comment t) (t ;; go to end of line and try again (end-of-line) (haskell-fill-paragraph justify)))))) ;; (defun haskell-adaptive-fill () ;; ;; We want to use "-- " as the prefix of "-- |", etc. ;; (let* ((line-end (save-excursion (end-of-line) (point))) ;; (line-start (point))) ;; (save-excursion ;; (unless (in-comment) ;; ;; Try to find the start of a comment. We only fill comments. ;; (search-forward-regexp comment-start-skip line-end t)) ;; (when (in-comment) ;; (let ();(prefix-start (point))) ;; (skip-syntax-forward "^w") ;; (make-string (- (point) line-start) ?\s)))))) ;;;###autoload (define-derived-mode literate-haskell-mode haskell-mode "LitHaskell" "As `haskell-mode' but for literate scripts." (setq haskell-literate (save-excursion (goto-char (point-min)) (cond ((re-search-forward "^\\\\\\(begin\\|end\\){code}$" nil t) 'tex) ((re-search-forward "^>" nil t) 'bird) (t haskell-literate-default)))) (if (eq haskell-literate 'bird) ;; fill-comment-paragraph isn't much use there, and even gets confused ;; by the syntax-table text-properties we add to mark the first char ;; of each line as a comment-starter. (set (make-local-variable 'fill-paragraph-handle-comment) nil)) (set (make-local-variable 'mode-line-process) '("/" (:eval (symbol-name haskell-literate))))) ;;;###autoload (add-to-list 'auto-mode-alist '("\\.[gh]s\\'" . haskell-mode)) ;;;###autoload (add-to-list 'auto-mode-alist '("\\.l[gh]s\\'" . literate-haskell-mode)) ;;;###autoload (add-to-list 'auto-mode-alist '("\\.hsc\\'" . haskell-mode)) ;;;###autoload (add-to-list 'interpreter-mode-alist '("runghc" . haskell-mode)) ;;;###autoload (add-to-list 'interpreter-mode-alist '("runhaskell" . haskell-mode)) ;;;###autoload (add-to-list 'completion-ignored-extensions ".hi") (defcustom haskell-hoogle-command (if (executable-find "hoogle") "hoogle") "Name of the command to use to query Hoogle. If nil, use the Hoogle web-site." :group 'haskell :type '(choice (const :tag "Use Web-site" nil) string)) (defcustom haskell-hoogle-url "http://haskell.org/hoogle/?q=%s" "Default value for hoogle web site. " :group 'haskell :type '(choice (const :tag "haskell-org" "http://haskell.org/hoogle/?q=%s") (const :tag "fp-complete" "https://www.fpcomplete.com/hoogle?q=%s") string)) ;;;###autoload (defun haskell-hoogle (query &optional info) "Do a Hoogle search for QUERY. When `haskell-hoogle-command' is non-nil, this command runs that. Otherwise, it opens a hoogle search result in the browser. If prefix argument INFO is given, then `haskell-hoogle-command' is asked to show extra info for the items matching QUERY.." (interactive (let ((def (haskell-ident-at-point))) (if (and def (symbolp def)) (setq def (symbol-name def))) (list (read-string (if def (format "Hoogle query (default %s): " def) "Hoogle query: ") nil nil def) current-prefix-arg))) (if (null haskell-hoogle-command) (browse-url (format haskell-hoogle-url (url-hexify-string query))) (let ((hoogle-args (append (when info '("-i")) (list "--color" (shell-quote-argument query))))) (with-help-window "*hoogle*" (with-current-buffer standard-output (insert (shell-command-to-string (concat haskell-hoogle-command (if info " -i " "") " --color " (shell-quote-argument query)))) (ansi-color-apply-on-region (point-min) (point-max))))))) ;;;###autoload (defalias 'hoogle 'haskell-hoogle) (defvar hoogle-server-process-name "emacs-local-hoogle") (defvar hoogle-server-buffer-name (format "*%s*" hoogle-server-process-name)) (defvar hoogle-port-number 49513 "Port number.") (defun hoogle-start-server () "Start hoogle local server." (interactive) (unless (hoogle-server-live-p) (start-process hoogle-server-process-name (get-buffer-create hoogle-server-buffer-name) "/bin/sh" "-c" (format "hoogle server -p %i" hoogle-port-number)))) (defun hoogle-server-live-p () "Whether hoogle server is live or not." (condition-case err (process-live-p (get-buffer-create hoogle-server-buffer-name)) (error nil))) (defun hoogle-kill-server () "Kill hoogle server if it is live." (interactive) (when (hoogle-server-live-p) (kill-process (get-buffer-create hoogle-server-buffer-name)))) ;;;###autoload (defun hoogle-lookup-from-local () "Lookup by local hoogle." (interactive) (if (hoogle-server-live-p) (browse-url (format "http://localhost:%i/?hoogle=%s" hoogle-port-number (read-string "hoogle: " (haskell-ident-at-point)))) (when (y-or-n-p "hoogle server not found, start hoogle server?") (if (executable-find "hoogle") (hoogle-start-server) (error "hoogle is not installed"))))) (defcustom haskell-hayoo-url "http://hayoo.fh-wedel.de/?query=%s" "Default value for hayoo web site. " :group 'haskell :type '(choice (const :tag "fh-wedel.de" "http://hayoo.fh-wedel.de/?query=%s") string)) ;;;###autoload (defun haskell-hayoo (query) "Do a Hayoo search for QUERY." (interactive (let ((def (haskell-ident-at-point))) (if (and def (symbolp def)) (setq def (symbol-name def))) (list (read-string (if def (format "Hayoo query (default %s): " def) "Hayoo query: ") nil nil def)))) (browse-url (format haskell-hayoo-url (url-hexify-string query)))) ;;;###autoload (defalias 'hayoo 'haskell-hayoo) (defcustom haskell-check-command "hlint" "*Command used to check a Haskell file." :group 'haskell :type '(choice (const "hlint") (const "ghc -fno-code") (string :tag "Other command"))) (defcustom haskell-stylish-on-save nil "Whether to run stylish-haskell on the buffer before saving." :group 'haskell :type 'boolean) (defcustom haskell-tags-on-save nil "Generate tags via hasktags after saving." :group 'haskell :type 'boolean) (defvar haskell-saved-check-command nil "Internal use.") (defcustom haskell-indent-spaces 2 "Number of spaces to indent inwards." :group 'haskell) ;; Like Python. Should be abstracted, sigh. (defun haskell-check (command) "Check a Haskell file (default current buffer's file). Runs COMMAND, a shell command, as if by `compile'. See `haskell-check-command' for the default." (interactive (list (read-string "Checker command: " (or haskell-saved-check-command (concat haskell-check-command " " (let ((name (buffer-file-name))) (if name (file-name-nondirectory name)))))))) (setq haskell-saved-check-command command) (save-some-buffers (not compilation-ask-about-save) nil) (compilation-start command)) (defun haskell-flymake-init () "Flymake init function for Haskell. To be added to `flymake-init-create-temp-buffer-copy'." (let ((checker-elts (and haskell-saved-check-command (split-string haskell-saved-check-command)))) (list (car checker-elts) (append (cdr checker-elts) (list (flymake-init-create-temp-buffer-copy 'flymake-create-temp-inplace)))))) (add-to-list 'flymake-allowed-file-name-masks '("\\.l?hs\\'" haskell-flymake-init)) (defun haskell-mode-suggest-indent-choice () "Ran when the user tries to indent in the buffer but no indentation mode has been selected. Explains what has happened and suggests reading docs for `haskell-mode-hook'." (interactive) (error "You tried to do an indentation command, but an indentation mode has not been enabled yet. Run M-x describe-variable haskell-mode-hook for a list of such modes.")) (defun haskell-mode-format-imports () "Format the imports by aligning and sorting them." (interactive) (let ((col (current-column))) (haskell-sort-imports) (haskell-align-imports) (goto-char (+ (line-beginning-position) col)))) (defun haskell-mode-before-save-handler () "Function that will be called before buffer's saving." ) (defun haskell-mode-jump-to-loc (loc) "Jump to the given location. LOC = (list FILE LINE COL)" (find-file (elt loc 0)) (goto-char (point-min)) (forward-line (1- (elt loc 1))) (goto-char (+ (line-beginning-position) (1- (elt loc 2))))) ;; From Bryan O'Sullivan's blog: ;; http://www.serpentine.com/blog/2007/10/09/using-emacs-to-insert-scc-annotations-in-haskell-code/ (defun haskell-mode-insert-scc-at-point () "Insert an SCC annotation at point." (interactive) (if (or (looking-at "\\b\\|[ \t]\\|$") (and (not (bolp)) (save-excursion (forward-char -1) (looking-at "\\b\\|[ \t]")))) (let ((space-at-point (looking-at "[ \t]"))) (unless (and (not (bolp)) (save-excursion (forward-char -1) (looking-at "[ \t]"))) (insert " ")) (insert "{-# SCC \"\" #-}") (unless space-at-point (insert " ")) (forward-char (if space-at-point -5 -6))) (error "Not over an area of whitespace"))) ;; Also Bryan O'Sullivan's. (defun haskell-mode-kill-scc-at-point () "Kill the SCC annotation at point." (interactive) (save-excursion (let ((old-point (point)) (scc "\\({-#[ \t]*SCC \"[^\"]*\"[ \t]*#-}\\)[ \t]*")) (while (not (or (looking-at scc) (bolp))) (forward-char -1)) (if (and (looking-at scc) (<= (match-beginning 1) old-point) (> (match-end 1) old-point)) (kill-region (match-beginning 0) (match-end 0)) (error "No SCC at point"))))) (defun haskell-guess-module-name () "Guess the current module name of the buffer." (interactive) (let ((components (cl-loop for part in (reverse (split-string (buffer-file-name) "/")) while (let ((case-fold-search nil)) (string-match "^[A-Z]+" part)) collect (replace-regexp-in-string "\\.l?hs$" "" part)))) (mapconcat 'identity (reverse components) "."))) (defvar haskell-auto-insert-module-format-string "-- | \n\nmodule %s where\n\n" "Template string that will be inserted in new haskell buffers via `haskell-auto-insert-module-template'.") (defun haskell-auto-insert-module-template () "Insert a module template for the newly created buffer." (interactive) (when (and (= (point-min) (point-max)) (buffer-file-name)) (insert (format haskell-auto-insert-module-format-string (haskell-guess-module-name))) (goto-char (point-min)) (end-of-line))) ;; Provide ourselves: (provide 'haskell-mode) ;;; haskell-mode.el ends here haskell-mode-13.14.2/haskell-modules.el000066400000000000000000000115171253441665600176630ustar00rootroot00000000000000;;; haskell-modules.el --- ;; Copyright (c) 2014 Chris Done. All rights reserved. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: (require 'haskell-sort-imports) (require 'haskell-align-imports) (require 'haskell-session) (require 'haskell-navigate-imports) (require 'haskell-complete-module) (require 'haskell-sandbox) (defun haskell-add-import (&optional module) "Add an import to the import list." (interactive) (save-excursion (goto-char (point-max)) (haskell-navigate-imports) (insert (haskell-import-for-module (or module (haskell-complete-module-read "Module: " (haskell-session-all-modules (haskell-modules-session)))))) (haskell-sort-imports) (haskell-align-imports))) (defun haskell-import-for-module (module) "Get import statements for the given module." (let ((mapping (assoc module haskell-import-mapping))) (if mapping (cdr mapping) (concat (read-from-minibuffer "Import line: " (format "import %s" module)) "\n")))) ;;;###autoload (defun haskell-session-installed-modules (session &optional dontcreate) "Get the modules installed in the current package set. If DONTCREATE is non-nil don't create a new session." ;; TODO: Again, this makes HEAVY use of unix utilities. It'll work ;; fine in Linux, probably okay on OS X, and probably not at all on ;; Windows. Again, if someone wants to test on Windows and come up ;; with alternatives that's OK. ;; ;; Ideally all these package queries can be provided by a Haskell ;; program based on the Cabal API. Possibly as a nice service. Such ;; a service could cache and do nice things like that. For now, this ;; simple shell script takes us far. ;; ;; Probably also we can take the code from inferior-haskell-mode. ;; ;; Ugliness aside, if it saves us time to type it's a winner. ;; ;; FIXME/TODO: add support for (eq 'cabal-repl (haskell-process-type)) (let ((session (haskell-session-maybe))) (when session (let ((modules (shell-command-to-string (format "%s | %s | %s" (cond ((haskell-sandbox-exists-p session) (concat "ghc-pkg dump -f " (shell-quote-argument (haskell-sandbox-pkgdb session)))) (t "ghc-pkg dump")) "egrep '^(exposed-modules: | )[A-Z]'" "cut -c18-")))) (split-string modules))))) ;;;###autoload (defun haskell-session-all-modules (session &optional dontcreate) "Get all modules -- installed or in the current project. If DONTCREATE is non-nil don't create a new session." (append (haskell-session-installed-modules session dontcreate) (haskell-session-project-modules session dontcreate))) ;;;###autoload (defun haskell-session-project-modules (session &optional dontcreate) "Get the modules of the current project. If DONTCREATE is non-nil don't create a new session." (if (or (not dontcreate) (haskell-session-maybe)) (let* ((modules (shell-command-to-string (format "%s && %s" (format "cd %s" (haskell-session-cabal-dir session)) ;; TODO: Use a different, better source. Possibly hasktags or some such. ;; TODO: At least make it cross-platform. Linux ;; (and possibly OS X) have egrep, Windows ;; doesn't -- or does it via Cygwin or MinGW? ;; This also doesn't handle module\nName. But those gits can just cut it out! "egrep '^module[\t\r ]+[^(\t\r ]+' . -r -I --include='*.*hs' --include='*.hsc' -s -o -h | sed 's/^module[\t\r ]*//' | sort | uniq")))) (split-string modules)))) (defun haskell-modules-session () "Get the `haskell-session', throw an error if it's not available." (or (haskell-session-maybe) (haskell-session-assign (or (haskell-session-from-buffer) (haskell-session-choose) (error "No session associated with this buffer. Try M-x haskell-session-change or report this as a bug."))))) (provide 'haskell-modules) haskell-mode-13.14.2/haskell-move-nested.el000066400000000000000000000107071253441665600204410ustar00rootroot00000000000000;;; haskell-move-nested.el --- Change the column of text nested below a line ;; Copyright (C) 2010 Chris Done ;; Author: Chris Done ;; This file is not part of GNU Emacs. ;; This program is free software: you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as ;; published by the Free Software Foundation, either version 3 of ;; the License, or (at your option) any later version. ;; This program is distributed in the hope that it will be ;; useful, but WITHOUT ANY WARRANTY; without even the implied ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. See the GNU General Public License for more details. ;; You should have received a copy of the GNU General Public ;; License along with this program. If not, see ;; . ;;; Commentary: ;; This module is intended for Haskell mode users, but is ;; independent of Haskell mode. ;; Example usage: ;; (define-key haskell-mode-map (kbd "C-,") 'haskell-move-nested-left) ;; (define-key haskell-mode-map (kbd "C-.") 'haskell-move-nested-right) ;;; Code: ;;;###autoload (defun haskell-move-nested (cols) "Shift the nested off-side-rule block adjacent to point by COLS columns to the right. In Transient Mark mode, if the mark is active, operate on the contents of the region instead. " (save-excursion (if (and transient-mark-mode mark-active) (progn (indent-rigidly (region-beginning) (region-end) cols) (setq deactivate-mark nil)) (let ((region (haskell-move-nested-region))) (when region (indent-rigidly (car region) (cdr region) cols)))))) ;;;###autoload (defun haskell-move-nested-right (cols) "Increase indentation of the following off-side-rule block adjacent to point. Use a numeric prefix argument to indicate amount of indentation to apply. In Transient Mark mode, if the mark is active, operate on the contents of the region instead." (interactive "p") (haskell-move-nested cols) ) ;;;###autoload (defun haskell-move-nested-left (cols) "Decrease indentation of the following off-side-rule block adjacent to point. Use a numeric prefix argument to indicate amount of indentation to apply. In Transient Mark mode, if the mark is active, operate on the contents of the region instead." (interactive "p") (haskell-move-nested (- cols)) ) (defun haskell-move-nested-region () "Infer region off-side-rule block adjacent to point. Used by `haskell-move-nested'. " (save-excursion (let ((starting-level (current-column))) (forward-line) (let ((current-level (haskell-move-nested-indent-level))) (let ((start-point (line-beginning-position)) (start-end-point (line-end-position)) (end-point nil) (last-line 0)) (forward-line) (while (and (not (= (line-beginning-position) last-line)) (or (> (haskell-move-nested-indent-level) starting-level) (and (> current-level starting-level) (>= (haskell-move-nested-indent-level) current-level)))) (setq last-line (line-beginning-position)) (setq end-point (line-end-position)) (forward-line)) (cons start-point (or end-point start-end-point))))))) (defun haskell-move-nested-indent-level () (max 0 (1- (length (buffer-substring-no-properties (line-beginning-position) (or (save-excursion (goto-char (line-beginning-position)) (search-forward-regexp "[^ ]" (line-end-position) t 1)) (line-beginning-position))))))) (defun haskell-kill-nested () "Kill the nested region after point." (interactive) (let ((start (point)) (reg (save-excursion (search-backward-regexp "^[ ]+" (line-beginning-position) t 1) (search-forward-regexp "[^ ]" (line-end-position) t 1) (haskell-move-nested-region)))) (kill-region start (cdr reg)))) (defun haskell-delete-nested () "Kill the nested region after point." (interactive) (let ((start (point)) (reg (save-excursion (search-backward-regexp "^[ ]+" (line-beginning-position) t 1) (search-forward-regexp "[^ ]" (line-end-position) t 1) (haskell-move-nested-region)))) (delete-region start (cdr reg)))) (provide 'haskell-move-nested) ;;; haskell-move-nested.el ends here haskell-mode-13.14.2/haskell-navigate-imports.el000066400000000000000000000106631253441665600215050ustar00rootroot00000000000000;;; haskell-navigate-imports.el --- A function for cycling through Haskell import lists ;; Copyright (C) 2010 Chris Done ;; Author: Chris Done ;; This file is not part of GNU Emacs. ;; This program is free software: you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as ;; published by the Free Software Foundation, either version 3 of ;; the License, or (at your option) any later version. ;; This program is distributed in the hope that it will be ;; useful, but WITHOUT ANY WARRANTY; without even the implied ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. See the GNU General Public License for more details. ;; You should have received a copy of the GNU General Public ;; License along with this program. If not, see ;; . ;;; Commentary: ;; The cycling step will stop once at the last import list so ;; that it is easy to add a new import list. ;; This module works completely independently of any libraries ;; (including haskell-mode). ;; Exports three interactive functions: ;; 1. haskell-navigate-imports ;; 2. haskell-navigate-imports-go ;; 3. haskell-navigate-imports-return ;; Example usage: ;; (require 'haskell-navigate-imports) ;; (define-key haskell-mode-map [f8] 'haskell-navigate-imports) ;;; Code: (defvar haskell-navigate-imports-start-point nil) ;;;###autoload (defun haskell-navigate-imports (&optional return) "Cycle the Haskell import lines or return to point (with prefix arg)." (interactive "P") (if return (haskell-navigate-imports-return) (haskell-navigate-imports-go))) ;;;###autoload (defun haskell-navigate-imports-go () "Go to the first line of a list of consequtive import lines. Cycles." (interactive) (unless (or (haskell-navigate-imports-line) (equal (line-beginning-position) (point-min)) (save-excursion (forward-line -1) (haskell-navigate-imports-line))) (setq haskell-navigate-imports-start-point (point))) (haskell-navigate-imports-go-internal)) ;;;###autoload (defun haskell-navigate-imports-return () "Return to the non-import point we were at before going to the module list. If we were originally at an import list, we can just cycle through easily." (interactive) (when haskell-navigate-imports-start-point (goto-char haskell-navigate-imports-start-point))) (defun haskell-navigate-imports-go-internal () "Go to the first line of a list of consequtive import lines. Cycle." (if (haskell-navigate-imports-line) (progn (haskell-navigate-imports-goto-end) (when (haskell-navigate-imports-find-forward-line) (haskell-navigate-imports-go-internal))) (let ((point (haskell-navigate-imports-find-forward-line))) (if point (goto-char point) (progn (goto-char (point-min)) (if (haskell-navigate-imports-find-forward-line) (haskell-navigate-imports-go-internal) (when (search-forward-regexp "^module" nil t 1) (search-forward "\n\n" nil t 1)))))))) (defun haskell-navigate-imports-goto-end () "Skip a bunch of consequtive import lines." (while (not (or (equal (point) (point-max)) (not (haskell-navigate-imports-line)))) (forward-line))) (defun haskell-navigate-imports-find-forward-line () "Return a point with at an import line, or nothing." (save-excursion (while (not (or (equal (point) (point-max)) (haskell-navigate-imports-after-imports-p) ;; This one just speeds it up. (haskell-navigate-imports-line))) (forward-line)) (let ((point (point))) (if (haskell-navigate-imports-line) (point) nil)))) (defun haskell-navigate-imports-line () "Try to match the current line as a regexp." (let ((line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) (if (string-match "^import " line) line nil))) (defun haskell-navigate-imports-after-imports-p () "Are we after the imports list? Just for a speed boost." (save-excursion (goto-char (line-beginning-position)) (not (not (search-forward-regexp "\\( = \\|\\\\| :: \\)" (line-end-position) t 1))))) (provide 'haskell-navigate-imports) ;;; haskell-navigate-imports.el ends here haskell-mode-13.14.2/haskell-package.el000066400000000000000000000122601253441665600176020ustar00rootroot00000000000000;;; haskell-package.el --- Interface for working with Cabal packages ;; Copyright (C) 2011 Chris Done ;; Author: Chris Done ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;;; Todo: ;;; Code: (require 'cl-lib) (defun haskell-package-conf-user-path-get () "Get the user conf path." (let ((out (shell-command-to-string "ghc-pkg --user list no-results-please"))) (string-match "\n\\(.*\\):\n" out) (match-string 1 out))) (defun haskell-package-conf-global-path-get () "Get the global conf path." (let ((out (shell-command-to-string "ghc-pkg --global list no-results-please"))) (string-match "\n\\(.*\\):\n" out) (match-string 1 out))) (defun haskell-package-get-all (conf) "Get all package descriptions for the given `conf'." (let ((all (shell-command-to-string (format "ghc-pkg -f %s dump" conf)))) (mapcar (lambda (text) (haskell-package-parse text)) (split-string all "\n---\n")))) (defun haskell-package-get (conf name version) "Get a package description for the given `name' and `version' in the given `conf'." (haskell-package-parse (shell-command-to-string (format "ghc-pkg -f %s describe %s-%s" conf name version)))) (cl-defstruct haskell-package "Haskell package object.") (defun haskell-package-parse (text) "Parse a package into a package object." (let ((pkg (haskell-package-read-description text))) (make-haskell-package :name (cdr (assoc "name" pkg)) :version (cdr (assoc "version" pkg)) :id (cdr (assoc "id" pkg)) :license (cdr (assoc "license" pkg)) :copyright (cdr (assoc "copyright" pkg)) :maintainer (cdr (assoc "maintainer" pkg)) :stability (cdr (assoc "stability" pkg)) :homepage (cdr (assoc "homepage" pkg)) :package-url (cdr (assoc "package-url" pkg)) :description (cdr (assoc "description" pkg)) :categories (cdr (assoc "category" pkg)) :authors (cdr (assoc "author" pkg)) :is-exposed (equal "True" (cdr (assoc "exposed" pkg))) :exposed-modules (split-string (or (cdr (assoc "exposed-modules" pkg)) "") "[\n ]") :hidden-modules (split-string (or (cdr (assoc "hidden-modules" pkg)) "") "[\n ]") :imports-dirs (cdr (assoc "imports-dirs" pkg)) :library-dirs (cdr (assoc "library-dirs" pkg)) :haskell-libraries (cdr (assoc "haskell-libraries" pkg)) :extra-libraries (cdr (assoc "extra-libraries" pkg)) :extra-ghci-libraries (cdr (assoc "extra-ghci-libraries" pkg)) :include-dirs (cdr (assoc "include-dirs" pkg)) :includes (cdr (assoc "includes" pkg)) :depends (cdr (assoc "depends" pkg)) :hugs-options (cdr (assoc "hugs-options" pkg)) :cc-options (cdr (assoc "cc-options" pkg)) :ld-options (cdr (assoc "ld-options" pkg)) :framework-dirs (cdr (assoc "framework-dirs" pkg)) :frameworks (cdr (assoc "frameworks" pkg)) :haddock-interfaces (cdr (assoc "haddock-interfaces" pkg)) :haddock-html (cdr (assoc "haddock-html" pkg))))) (defun haskell-package-read-description (text) "Return an association list of key-values from a pkg description string." (let* ((marked (replace-regexp-in-string "\n\\([^ ]\\)" (lambda (match) (concat "\n:" (substring match 1))) text)) (alist (mapcar 'haskell-package-key-value (split-string marked "\n:")))) alist)) (defun haskell-package-key-value (entry) "Return a (key . value) pair from an entry." (let ((key-values (split-string entry ": "))) (if (listp key-values) (cons (car key-values) (replace-regexp-in-string "\n[ ]*" " " (mapconcat 'identity (cdr key-values) ": "))) key-values))) (defun haskell-package-list-get (conf) "Get the list of packages in the given config." (haskell-package-list-parse (shell-command-to-string (format "ghc-pkg -f %s list" conf)))) (defun haskell-package-list-parse (text) "Parse the list of installed packges." (let* ((lines (split-string text "\n "))) (mapcar (lambda (line) (string-match "^{?\\([a-zA-Z0-9-_]+\\)-\\([0-9.]+\\)}?$" line) (cons (match-string 1 line) (match-string 2 line))) (cl-delete-if (lambda (line) (not (string-match "^{?[a-zA-Z0-9-_]+-[0-9.]+}?$" line))) lines)))) (provide 'haskell-package) ;;; haskell-package.el ends here haskell-mode-13.14.2/haskell-presentation-mode.el000066400000000000000000000055341253441665600216520ustar00rootroot00000000000000;;; haskell-presentation-mode.el --- Presenting Haskell things ;; Copyright (C) 2013 Chris Done ;; Author: Chris Done ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;;; Code: (require 'haskell-mode) (require 'haskell-session) (define-derived-mode haskell-presentation-mode haskell-mode "Presentation" "Major mode for viewing Haskell snippets. \\{hypertext-mode-map}" (setq case-fold-search nil)) (defconst haskell-present-buffer-name "*Haskell Presentation*" "Haskell Presentation buffer name.") (defconst haskell-present-hint-message "-- Hit `q' to close this window; `c' to clear.\n\n" "Hint message appered in Haskell Presentation buffer.") (easy-mmode-defmap haskell-presentation-mode-map `(("q" . #'quit-window) ("c" . #'haskell-present-clear)) "The base key map for `haskell-presentation-mode'.") (defun haskell-present-clear () "Clear Haskell Presentation buffer." (interactive) (let ((hp-buf (get-buffer haskell-present-buffer-name))) (when hp-buf (with-current-buffer hp-buf (let ((buffer-read-only nil)) (erase-buffer) (insert haskell-present-hint-message)))))) (defun haskell-present (session code &optional clear) "Present given code in a popup buffer. Creates temporal Haskell Presentation buffer and assigns it to given haskell SESSION; presented CODE will be fontified as haskell code. Give an optional non-nil CLEAR arg to clear the buffer before presenting message." (let ((buffer (get-buffer-create haskell-present-buffer-name))) (with-current-buffer buffer (haskell-presentation-mode) (when (boundp 'shm-display-quarantine) (set (make-local-variable 'shm-display-quarantine) nil)) (when clear (haskell-present-clear)) (haskell-session-assign session) (save-excursion (let ((buffer-read-only nil)) (goto-char (point-min)) (forward-line 2) (insert code "\n\n"))) (if (eq major-mode 'haskell-presentation-mode) (switch-to-buffer buffer) (pop-to-buffer buffer))))) (provide 'haskell-presentation-mode) ;;; haskell-presentation-mode.el ends here haskell-mode-13.14.2/haskell-process.el000066400000000000000000000440171253441665600176720ustar00rootroot00000000000000;;; haskell-process.el --- Communicating with the inferior Haskell process ;; Copyright (C) 2011 Chris Done ;; Author: Chris Done ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'cl-lib) (require 'json) (require 'url-util) (require 'haskell-compat) (require 'haskell-session) (require 'haskell-customize) (require 'haskell-string) (defconst haskell-process-prompt-regex "\4" "Used for delimiting command replies. 4 is End of Transmission.") (defvar haskell-reload-p nil "Used internally for `haskell-process-loadish'.") (defconst haskell-process-greetings (list "Hello, Haskell!" "The lambdas must flow." "Hours of hacking await!" "The next big Haskell project is about to start!" "Your wish is my IO ().") "Greetings for when the Haskell process starts up.") (defconst haskell-process-logo (expand-file-name "logo.svg" haskell-mode-pkg-base-dir) "Haskell logo for notifications.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Accessing commands -- using cl 'defstruct' (cl-defstruct haskell-command "Data structure representing a command to be executed when with a custom state and three callback." ;; hold the custom command state ;; state :: a state ;; called when to execute a command ;; go :: a -> () go ;; called whenever output was collected from the haskell process ;; live :: a -> Response -> Bool live ;; called when the output from the haskell process indicates that the command ;; is complete ;; complete :: a -> Response -> () complete) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Building the process (defun haskell-process-compute-process-log-and-command (session hptype) "Compute the log and process to start command for the SESSION from the HPTYPE. Do not actually start any process. HPTYPE is the result of calling `'haskell-process-type`' function." (let ((session-name (haskell-session-name session))) (cl-ecase hptype ('ghci (append (list (format "Starting inferior GHCi process %s ..." haskell-process-path-ghci) session-name nil) (apply haskell-process-wrapper-function (list (cons haskell-process-path-ghci haskell-process-args-ghci))))) ('cabal-repl (append (list (format "Starting inferior `cabal repl' process using %s ..." haskell-process-path-cabal) session-name nil) (apply haskell-process-wrapper-function (list (append (list haskell-process-path-cabal "repl") haskell-process-args-cabal-repl (let ((target (haskell-session-target session))) (if target (list target) nil))))))) ('cabal-ghci (append (list (format "Starting inferior cabal-ghci process using %s ..." haskell-process-path-cabal-ghci) session-name nil) (apply haskell-process-wrapper-function (list (list haskell-process-path-cabal-ghci)))))))) (defun haskell-process-make (name) "Make an inferior Haskell process." (list (cons 'name name))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Process communication (defun haskell-process-sentinel (proc event) "The sentinel for the process pipe." (let ((session (haskell-process-project-by-proc proc))) (when session (let* ((process (haskell-session-process session))) (unless (haskell-process-restarting process) (haskell-process-log (propertize (format "Event: %S\n" event) 'face '((:weight bold)))) (haskell-process-log (propertize "Process reset.\n" 'face font-lock-comment-face)) (run-hook-with-args 'haskell-process-ended-hook process)))))) (defun haskell-process-filter (proc response) "The filter for the process pipe." (let ((i 0)) (cl-loop for line in (split-string response "\n") do (haskell-process-log (concat (if (= i 0) (propertize "<- " 'face font-lock-comment-face) " ") (propertize line 'face 'haskell-interactive-face-compile-warning))) do (setq i (1+ i)))) (let ((session (haskell-process-project-by-proc proc))) (when session (if (haskell-process-cmd (haskell-session-process session)) (haskell-process-collect session response (haskell-session-process session)) (haskell-process-log (replace-regexp-in-string "\4" "" response)))))) (defun haskell-process-log (msg) "Effective append MSG to the process log (if enabled)." (when haskell-process-log (let* ((append-to (get-buffer-create "*haskell-process-log*")) (windows (get-buffer-window-list append-to t t)) move-point-in-windows) (with-current-buffer append-to (setq buffer-read-only nil) ;; record in which windows we should keep point at eob. (dolist (window windows) (when (= (window-point window) (point-max)) (push window move-point-in-windows))) (let (return-to-position) ;; decide whether we should reset point to return-to-position ;; or leave it at eob. (unless (= (point) (point-max)) (setq return-to-position (point)) (goto-char (point-max))) (insert "\n" msg "\n") (when return-to-position (goto-char return-to-position))) ;; advance to point-max in windows where it is needed (dolist (window move-point-in-windows) (set-window-point window (point-max))) (setq buffer-read-only t))))) (defun haskell-process-project-by-proc (proc) "Find project by process." (cl-find-if (lambda (project) (string= (haskell-session-name project) (process-name proc))) haskell-sessions)) (defun haskell-process-collect (session response process) "Collect input for the response until receives a prompt." (haskell-process-set-response process (concat (haskell-process-response process) response)) (while (haskell-process-live-updates process)) (when (string-match haskell-process-prompt-regex (haskell-process-response process)) (haskell-command-exec-complete (haskell-process-cmd process) (replace-regexp-in-string haskell-process-prompt-regex "" (haskell-process-response process))) (haskell-process-reset process) (haskell-process-trigger-queue process))) (defun haskell-process-reset (process) "Reset the process's state, ready for the next send/reply." (progn (haskell-process-set-response-cursor process 0) (haskell-process-set-response process "") (haskell-process-set-cmd process nil))) (defun haskell-process-consume (process regex) "Consume a regex from the response and move the cursor along if succeed." (when (string-match regex (haskell-process-response process) (haskell-process-response-cursor process)) (haskell-process-set-response-cursor process (match-end 0)) t)) (defun haskell-process-send-string (process string) "Try to send a string to the process's process. Ask to restart if it's not running." (let ((child (haskell-process-process process))) (if (equal 'run (process-status child)) (let ((out (concat string "\n"))) (haskell-process-log (propertize (concat (propertize "-> " 'face font-lock-comment-face) (propertize string 'face font-lock-string-face)) 'face '((:weight bold)))) (process-send-string child out)) (unless (haskell-process-restarting process) (run-hook-with-args 'haskell-process-ended process))))) (defun haskell-process-live-updates (process) "Process live updates." (haskell-command-exec-live (haskell-process-cmd process) (haskell-process-response process))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Making commands (defun haskell-process-queue-without-filters (process line) "Queue LINE to be sent to PROCESS without bothering to look at the response." (haskell-process-queue-command process (make-haskell-command :state (cons process line) :go (lambda (state) (haskell-process-send-string (car state) (cdr state)))))) (defun haskell-process-queue-command (process command) "Add a command to the process command queue." (haskell-process-cmd-queue-add process command) (haskell-process-trigger-queue process)) (defun haskell-process-trigger-queue (process) "Trigger the next command in the queue to be ran if there is no current command." (if (and (haskell-process-process process) (process-live-p (haskell-process-process process))) (unless (haskell-process-cmd process) (let ((cmd (haskell-process-cmd-queue-pop process))) (when cmd (haskell-process-set-cmd process cmd) (haskell-command-exec-go cmd)))) (progn (haskell-process-reset process) (haskell-process-set process 'command-queue nil) (run-hook-with-args 'haskell-process-ended process)))) (defun haskell-process-queue-flushed-p (process) "Return t if command queue has been completely processed." (not (or (haskell-process-cmd-queue process) (haskell-process-cmd process)))) (defun haskell-process-queue-flush (process) "Block till PROCESS' command queue has been completely processed. This uses `accept-process-output' internally." (while (not (haskell-process-queue-flushed-p process)) (haskell-process-trigger-queue process) (accept-process-output (haskell-process-process process) 1))) (defun haskell-process-queue-sync-request (process reqstr) "Queue submitting REQSTR to PROCESS and return response blockingly." (let ((cmd (make-haskell-command :state (cons nil process) :go `(lambda (s) (haskell-process-send-string (cdr s) ,reqstr)) :complete 'setcar))) (haskell-process-queue-command process cmd) (haskell-process-queue-flush process) (car-safe (haskell-command-state cmd)))) (defun haskell-process-get-repl-completions (process inputstr) "Perform `:complete repl ...' query for INPUTSTR using PROCESS." (let* ((reqstr (concat ":complete repl " (haskell-string-literal-encode inputstr))) (rawstr (haskell-process-queue-sync-request process reqstr))) (if (string-prefix-p "unknown command " rawstr) (error "GHCi lacks `:complete' support (try installing 7.8 or ghci-ng)") (let* ((s1 (split-string rawstr "\r?\n" t)) (cs (mapcar #'haskell-string-literal-decode (cdr s1))) (h0 (car s1))) ;; " " (unless (string-match "\\`\\([0-9]+\\) \\([0-9]+\\) \\(\".*\"\\)\\'" h0) (error "Invalid `:complete' response")) (let ((cnt1 (match-string 1 h0)) (h1 (haskell-string-literal-decode (match-string 3 h0)))) (unless (= (string-to-number cnt1) (length cs)) (error "Lengths inconsistent in `:complete' reponse")) (cons h1 cs)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Accessing the process (defun haskell-process-get (process key) "Get the PROCESS's KEY value. Returns nil if KEY not set." (cdr (assq key process))) (defun haskell-process-set (process key value) "Set the PROCESS's KEY to VALUE. Returns newly set VALUE." (if process (let ((cell (assq key process))) (if cell (setcdr cell value) ; modify cell in-place (setcdr process (cons (cons key value) (cdr process))) ; new cell value)) (display-warning 'haskell-interactive "`haskell-process-set' called with nil process"))) ;; Wrappers using haskell-process-{get,set} (defun haskell-process-set-sent-stdin (p v) "We've sent stdin, so let's not clear the output at the end." (haskell-process-set p 'sent-stdin v)) (defun haskell-process-sent-stdin-p (p) "Did we send any stdin to the process during evaluation?" (haskell-process-get p 'sent-stdin)) (defun haskell-process-set-suggested-imports (p v) "Remember what imports have been suggested, to avoid re-asking about the same imports." (haskell-process-set p 'suggested-imported v)) (defun haskell-process-suggested-imports (p) "Get what modules have already been suggested and accepted." (haskell-process-get p 'suggested-imported)) (defun haskell-process-set-evaluating (p v) "Set status of evaluating to be on/off." (haskell-process-set p 'evaluating v)) (defun haskell-process-evaluating-p (p) "Set status of evaluating to be on/off." (haskell-process-get p 'evaluating)) (defun haskell-process-set-process (p v) "Set the process's inferior process." (haskell-process-set p 'inferior-process v)) (defun haskell-process-process (p) "Get the process child." (haskell-process-get p 'inferior-process)) (defun haskell-process-name (p) "Get the process name." (haskell-process-get p 'name)) (defun haskell-process-cmd (p) "Get the process's current command. Return nil if no current command." (haskell-process-get p 'current-command)) (defun haskell-process-set-cmd (p v) "Set the process's current command." (haskell-process-set-evaluating p nil) (haskell-process-set-sent-stdin p nil) (haskell-process-set-suggested-imports p nil) (haskell-process-set p 'current-command v)) (defun haskell-process-response (p) "Get the process's current response." (haskell-process-get p 'current-response)) (defun haskell-process-session (p) "Get the process's current session." (haskell-process-get p 'session)) (defun haskell-process-set-response (p v) "Set the process's current response." (haskell-process-set p 'current-response v)) (defun haskell-process-set-session (p v) "Set the process's current session." (haskell-process-set p 'session v)) (defun haskell-process-response-cursor (p) "Get the process's current response cursor." (haskell-process-get p 'current-response-cursor)) (defun haskell-process-set-response-cursor (p v) "Set the process's response cursor." (haskell-process-set p 'current-response-cursor v)) ;; low-level command queue operations (defun haskell-process-restarting (process) "Is the PROCESS restarting?" (haskell-process-get process 'is-restarting)) (defun haskell-process-cmd-queue (process) "Get the PROCESS' command queue. New entries get added to the end of the list. Use `haskell-process-cmd-queue-add' and `haskell-process-cmd-queue-pop' to modify the command queue." (haskell-process-get process 'command-queue)) (defun haskell-process-cmd-queue-add (process cmd) "Add CMD to end of PROCESS's command queue." (cl-check-type cmd haskell-command) (haskell-process-set process 'command-queue (append (haskell-process-cmd-queue process) (list cmd)))) (defun haskell-process-cmd-queue-pop (process) "Pop the PROCESS' next entry from command queue. Returns nil if queue is empty." (let ((queue (haskell-process-cmd-queue process))) (when queue (haskell-process-set process 'command-queue (cdr queue)) (car queue)))) (defun haskell-process-unignore-file (session file) " Note to Windows Emacs hackers: chmod is how to change the mode of files in POSIX systems. This will not work on your operating system. There is a command a bit like chmod called \"Calcs\" that you can try using here: http://technet.microsoft.com/en-us/library/bb490872.aspx If it works, you can submit a patch to this function and remove this comment. " (shell-command (read-from-minibuffer "Permissions command: " (concat "chmod 700 " file))) (haskell-session-modify session 'ignored-files (lambda (files) (cl-remove-if (lambda (path) (string= path file)) files)))) (defun haskell-command-exec-go (command) "Call the command's go function." (let ((go-func (haskell-command-go command))) (when go-func (funcall go-func (haskell-command-state command))))) (defun haskell-command-exec-complete (command response) "Call the command's complete function." (let ((comp-func (haskell-command-complete command))) (when comp-func (condition-case e (funcall comp-func (haskell-command-state command) response) (quit (message "Quit")) (error (message "Haskell process command errored with: %S" e)))))) (defun haskell-command-exec-live (command response) "Trigger the command's live updates callback." (let ((live-func (haskell-command-live command))) (when live-func (funcall live-func (haskell-command-state command) response)))) (provide 'haskell-process) ;;; haskell-process.el ends here haskell-mode-13.14.2/haskell-repl.el000066400000000000000000000124521253441665600171540ustar00rootroot00000000000000;;; haskell-repl.el --- REPL evaluation ;; Copyright (c) 2014 Chris Done. All rights reserved. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: (require 'cl-lib) (require 'haskell-interactive-mode) (defun haskell-interactive-handle-expr () "Handle an inputted expression at the REPL." (when (haskell-interactive-at-prompt) (let ((expr (haskell-interactive-mode-input))) (unless (string= "" (replace-regexp-in-string " " "" expr)) (cond ;; If already evaluating, then the user is trying to send ;; input to the REPL during evaluation. Most likely in ;; response to a getLine-like function. ((and (haskell-process-evaluating-p (haskell-interactive-process)) (= (line-end-position) (point-max))) (goto-char (point-max)) (let ((process (haskell-interactive-process)) (string (buffer-substring-no-properties haskell-interactive-mode-result-end (point)))) ;; here we need to go to end of line again as evil-mode ;; might hae managed to put us one char back (goto-char (point-max)) (insert "\n") ;; Bring the marker forward (setq haskell-interactive-mode-result-end (point-max)) (haskell-process-set-sent-stdin process t) (haskell-process-send-string process string))) ;; Otherwise we start a normal evaluation call. (t (setq haskell-interactive-mode-old-prompt-start (copy-marker haskell-interactive-mode-prompt-start)) (set-marker haskell-interactive-mode-prompt-start (point-max)) (haskell-interactive-mode-history-add expr) (haskell-interactive-mode-do-expr expr))))))) (defun haskell-interactive-mode-do-expr (expr) (cond ((string-match "^:present " expr) (haskell-interactive-mode-do-presentation (replace-regexp-in-string "^:present " "" expr))) (t (haskell-interactive-mode-run-expr expr)))) (defun haskell-interactive-mode-run-expr (expr) "Run the given expression." (let ((session (haskell-interactive-session)) (process (haskell-interactive-process)) (lines (length (split-string expr "\n")))) (haskell-process-queue-command process (make-haskell-command :state (list session process expr 0) :go (lambda (state) (goto-char (point-max)) (insert "\n") (setq haskell-interactive-mode-result-end (point-max)) (haskell-process-send-string (cadr state) (haskell-interactive-mode-multi-line (cl-caddr state))) (haskell-process-set-evaluating (cadr state) t)) :live (lambda (state buffer) (unless (and (string-prefix-p ":q" (cl-caddr state)) (string-prefix-p (cl-caddr state) ":quit")) (let* ((cursor (cl-cadddr state)) (next (replace-regexp-in-string haskell-process-prompt-regex "" (substring buffer cursor)))) (haskell-interactive-mode-eval-result (car state) next) (setf (cl-cdddr state) (list (length buffer))) nil))) :complete (lambda (state response) (haskell-process-set-evaluating (cadr state) nil) (unless (haskell-interactive-mode-trigger-compile-error state response) (haskell-interactive-mode-expr-result state response))))))) (defun haskell-interactive-mode-expr-result (state response) "Print the result of evaluating the expression." (let ((response (with-temp-buffer (insert (haskell-interactive-mode-cleanup-response (cl-caddr state) response)) (haskell-interactive-mode-handle-h (point-min)) (buffer-string)))) (when haskell-interactive-mode-eval-mode (unless (haskell-process-sent-stdin-p (cadr state)) (haskell-interactive-mode-eval-as-mode (car state) response)))) (haskell-interactive-mode-prompt (car state))) (defun haskell-interactive-mode-eval-as-mode (session text) "Insert TEXT font-locked according to `haskell-interactive-mode-eval-mode'." (with-current-buffer (haskell-session-interactive-buffer session) (let ((inhibit-read-only t)) (delete-region (1+ haskell-interactive-mode-prompt-start) (point)) (goto-char (point-max)) (let ((start (point))) (insert (haskell-fontify-as-mode text haskell-interactive-mode-eval-mode)) (when haskell-interactive-mode-collapse (haskell-collapse start (point))))))) (provide 'haskell-repl) haskell-mode-13.14.2/haskell-sandbox.el000066400000000000000000000027021253441665600176450ustar00rootroot00000000000000;;; haskell-sandbox.el --- Support for sandboxes ;; Copyright (c) 2014 Chris Done. All rights reserved. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: (require 'cl-lib) (require 'haskell-session) (defun haskell-sandbox-path (session) "Is there a cabal sandbox?" (concat (haskell-session-cabal-dir session) "/.cabal-sandbox")) (defun haskell-sandbox-exists-p (session) "Is there a cabal sandbox?" (file-exists-p (haskell-sandbox-path session))) (defun haskell-sandbox-pkgdb (session) "Get the package database of the sandbox." (let* ((files (directory-files (haskell-sandbox-path session))) (dir (car (cl-remove-if-not (lambda (file) (string-match ".conf.d$" file)) files)))) (when dir (concat (haskell-sandbox-path session) "/" dir)))) (provide 'haskell-sandbox) haskell-mode-13.14.2/haskell-session.el000066400000000000000000000175071253441665600177030ustar00rootroot00000000000000;;; haskell-session.el --- Haskell sessions ;; Copyright (C) 2011-2012 Chris Done ;; Author: Chris Done ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;;; Todo: ;;; Code: (require 'cl-lib) (require 'haskell-cabal) (require 'haskell-string) (require 'haskell-customize) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Globals ;; Used internally (defvar haskell-session) (make-variable-buffer-local 'haskell-session) (defvar haskell-sessions (list) "All Haskell sessions in the Emacs session.") (defun haskell-session-tags-filename (session) "Get the filename for the TAGS file." (concat (haskell-session-cabal-dir session) "/TAGS")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Finding/clearing the session ;;;###autoload (defun haskell-session-maybe () "Maybe get the Haskell session, return nil if there isn't one." (if (default-boundp 'haskell-session) haskell-session (setq haskell-session nil))) (defun haskell-session-from-buffer () "Get the session based on the buffer." (when (and (buffer-file-name) (consp haskell-sessions)) (cl-reduce (lambda (acc a) (let ((dir (haskell-session-cabal-dir a t))) (if dir (if (string-prefix-p dir (file-name-directory (buffer-file-name))) (if acc (if (and (> (length (haskell-session-cabal-dir a t)) (length (haskell-session-cabal-dir acc t)))) a acc) a) acc) acc))) haskell-sessions :initial-value nil))) (defun haskell-session-default-name () "Generate a default project name for the new project prompt." (let ((file (haskell-cabal-find-file))) (or (when file (downcase (file-name-sans-extension (file-name-nondirectory file)))) "haskell"))) (defun haskell-session-assign (session) "Assing current buffer to SESSION. More verbose doc string for `haskell-session-assign` This could be helpfull for temporal or auxilar buffers such as presentation mode buffers (e.g. in case when session is killed with all relevant buffers)." (set (make-local-variable 'haskell-session) session)) (defun haskell-session-choose () "Find a session by choosing from a list of the current sessions." (when haskell-sessions (let* ((session-name (funcall haskell-completing-read-function "Choose Haskell session: " (cl-remove-if (lambda (name) (and haskell-session (string= (haskell-session-name haskell-session) name))) (mapcar 'haskell-session-name haskell-sessions)))) (session (cl-find-if (lambda (session) (string= (haskell-session-name session) session-name)) haskell-sessions))) session))) (defun haskell-session-clear () "Clear the buffer of any Haskell session choice." (set (make-local-variable 'haskell-session) nil)) (defun haskell-session-lookup (name) "Get the session by name." (cl-remove-if-not (lambda (s) (string= name (haskell-session-name s))) haskell-sessions)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Session modules (defun haskell-session-strip-dir (session file) "Strip the load dir from the file path." (let ((cur-dir (haskell-session-current-dir session))) (if (> (length file) (length cur-dir)) (if (string= (substring file 0 (length cur-dir)) cur-dir) (replace-regexp-in-string "^[/\\]" "" (substring file (length cur-dir))) file) file))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Accessing the session (defun haskell-session-current-dir (s) "Get the session current directory." (let ((dir (haskell-session-get s 'current-dir))) (or dir (error "No current directory.")))) (defun haskell-session-name (s) "Get the session name." (haskell-session-get s 'name)) (defun haskell-session-target (s) "Get the session build target." (let* ((maybe-target (haskell-session-get s 'target)) (target (if maybe-target maybe-target (let ((new-target (read-string "build target (empty for default):"))) (haskell-session-set-target s new-target))))) (if (not (string= target "")) target nil))) (defun haskell-session-set-target (s target) "Set the session build target." (haskell-session-set s 'target target)) (defun haskell-session-set-interactive-buffer (s v) "Set the session interactive buffer." (haskell-session-set s 'interactive-buffer v)) (defun haskell-session-set-process (s v) "Set the session process." (haskell-session-set s 'process v)) ;;;###autoload (defun haskell-session-process (s) "Get the session process." (haskell-session-get s 'process)) (defun haskell-session-set-cabal-dir (s v) "Set the session cabal-dir." (let ((true-path (file-truename v))) (haskell-session-set s 'cabal-dir true-path) (haskell-session-set-cabal-checksum s true-path))) (defun haskell-session-set-current-dir (s v) "Set the session current directory." (let ((true-path (file-truename v))) (haskell-session-set s 'current-dir true-path))) (defun haskell-session-set-cabal-checksum (s cabal-dir) "Set the session checksum of .cabal files" (haskell-session-set s 'cabal-checksum (haskell-cabal-compute-checksum cabal-dir))) (defun haskell-session-cabal-dir (s &optional no-prompt) "Get the session cabal-dir." (let ((dir (haskell-session-get s 'cabal-dir))) (if dir dir (unless no-prompt (let ((set-dir (haskell-cabal-get-dir))) (if set-dir (progn (haskell-session-set-cabal-dir s set-dir) set-dir) (haskell-session-cabal-dir s))))))) (defun haskell-session-modify (session key update) "Update the value at KEY in SESSION with UPDATE." (haskell-session-set session key (funcall update (haskell-session-get session key)))) (defun haskell-session-get (session key) "Get the SESSION's KEY value. Returns nil if KEY not set." (cdr (assq key session))) (defun haskell-session-set (session key value) "Set the SESSION's KEY to VALUE. Returns newly set VALUE." (let ((cell (assq key session))) (if cell (setcdr cell value) ; modify cell in-place (setcdr session (cons (cons key value) (cdr session))) ; new cell value))) (provide 'haskell-session) ;;; haskell-session.el ends here haskell-mode-13.14.2/haskell-simple-indent.el000066400000000000000000000231751253441665600207660ustar00rootroot00000000000000;;; haskell-simple-indent.el --- Simple indentation module for Haskell Mode ;; Copyright (C) 1998 Heribert Schuetz, Graeme E Moss ;; Author: Heribert Schuetz ;; Graeme E Moss ;; Keywords: indentation files Haskell ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; Purpose: ;; ;; To support simple indentation of Haskell scripts. ;; ;; ;; Installation: ;; ;; To bind TAB to the indentation command for all Haskell buffers, add ;; this to .emacs: ;; ;; (add-hook 'haskell-mode-hook 'turn-on-haskell-simple-indent) ;; ;; Otherwise, call `turn-on-haskell-simple-indent'. ;; ;; ;; Customisation: ;; ;; None supported. ;; ;; ;; History: ;; ;; If you have any problems or suggestions, after consulting the list ;; below, email gem@cs.york.ac.uk quoting the version of you are ;; using, the version of Emacs you are using, and a small example of ;; the problem or suggestion. ;; ;; Version 1.0: ;; Brought over from Haskell mode v1.1. ;; ;; Present Limitations/Future Work (contributions are most welcome!): ;; ;; (None so far.) ;;; Code: ;; All functions/variables start with ;; `(turn-(on/off)-)haskell-simple-indent'. (require 'haskell-mode) (defgroup haskell-simple-indent nil "Simple Haskell indentation." :link '(custom-manual "(haskell-mode)Indentation") :group 'haskell :prefix "haskell-simple-indent-") ;; Version. (defconst haskell-simple-indent-version "1.2" "`haskell-simple-indent' version number.") (defun haskell-simple-indent-version () "Echo the current version of `haskell-simple-indent' in the minibuffer." (interactive) (message "Using haskell-simple-indent version %s" haskell-simple-indent-version)) ;; Partly stolen from `indent-relative' in indent.el: (defun haskell-simple-indent () "Space out to under next visible indent point. Indent points are positions of non-whitespace following whitespace in lines preceeding point. Example: func arg cx = when (isTrue) $ do print 42 ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ A position is visible if it is to the left of the first non-whitespace (indentation) of every nonblank line between the position and the current line. If there is no visible indent point beyond the current column, position given by `indent-next-tab-stop' is used instead." (interactive) (let* ((start-column (or (save-excursion (back-to-indentation) (if (not (eolp)) (current-column))) (current-column))) (invisible-from nil) ; `nil' means infinity here (found) (indent)) (save-excursion ;; Loop stops if there no more lines above this one or when has ;; found a line starting at first column. (while (and (not found) (or (not invisible-from) (not (zerop invisible-from))) (zerop (forward-line -1))) ;; Ignore empty lines. (if (not (looking-at "[ \t]*\n")) (let ((this-indentation (current-indentation))) ;; Is this line so indented that it cannot have ;; influence on indentation points? (if (or (not invisible-from) (< this-indentation invisible-from)) (if (> this-indentation start-column) (setq invisible-from this-indentation) (let ((end (line-end-position))) (move-to-column start-column) ;; Is start-column inside a tab on this line? (if (> (current-column) start-column) (backward-char 1)) ;; Skip to the end of non-whitespace. (skip-chars-forward "^ \t" end) ;; Skip over whitespace. (skip-chars-forward " \t" end) ;; Indentation point found if not at the end of ;; line and if not covered by any line below ;; this one. In that case use invisible-from. (setq indent (if (or (= (point) end) (and invisible-from (> (current-column) invisible-from))) invisible-from (current-column))) ;; Signal that solution is found. (setq found t)))))))) (let ((opoint (point-marker))) ;; Indent to the calculated indent or last know invisible-from ;; or use tab-to-tab-stop. Try hard to keep cursor in the same ;; place or move it to the indentation if it was before it. And ;; keep content of the line intact. (setq indent (or indent invisible-from (if (fboundp 'indent-next-tab-stop) (indent-next-tab-stop start-column)) (let ((tabs tab-stop-list)) (while (and tabs (>= start-column (car tabs))) (setq tabs (cdr tabs))) (if tabs (car tabs))) (* (/ (+ start-column tab-width) tab-width) tab-width))) (indent-line-to indent) (if (> opoint (point)) (goto-char opoint)) (set-marker opoint nil)))) (defun haskell-simple-indent-backtab () "Indent backwards. Dual to `haskell-simple-indent'." (interactive) (let ((saved-column (or (save-excursion (back-to-indentation) (if (not (eolp)) (current-column))) (current-column))) (i 0) (x 0)) (save-excursion (back-to-indentation) (delete-region (line-beginning-position) (point))) (while (< (or (save-excursion (back-to-indentation) (if (not (eolp)) (current-column))) (current-column)) saved-column) (haskell-simple-indent) (setq i (+ i 1))) (save-excursion (back-to-indentation) (delete-region (line-beginning-position) (point))) (while (< x (- i 1)) (haskell-simple-indent) (setq x (+ x 1))))) (defun haskell-simple-indent-newline-same-col () "Make a newline and go to the same column as the current line." (interactive) (let ((point (point))) (let ((start-end (save-excursion (let* ((start (line-beginning-position)) (end (progn (goto-char start) (search-forward-regexp "[^ ]" (line-end-position) t 1)))) (when end (cons start (1- end))))))) (if start-end (progn (newline) (insert (buffer-substring-no-properties (car start-end) (cdr start-end)))) (newline))))) (defun haskell-simple-indent-newline-indent () "Make a newline on the current column and indent on step." (interactive) (haskell-simple-indent-newline-same-col) (insert (make-string haskell-indent-spaces ? ))) (defun haskell-simple-indent-comment-indent-function () "Haskell version of `comment-indent-function'." ;; This is required when filladapt is turned off. Without it, when ;; filladapt is not used, comments which start in column zero ;; cascade one character to the right (save-excursion (beginning-of-line) (let ((eol (line-end-position))) (and comment-start-skip (re-search-forward comment-start-skip eol t) (setq eol (match-beginning 0))) (goto-char eol) (skip-chars-backward " \t") (max comment-column (+ (current-column) (if (bolp) 0 1)))))) ;;;###autoload (define-minor-mode haskell-simple-indent-mode "Simple Haskell indentation mode that uses simple heuristic. In this minor mode, `indent-for-tab-command' (bound to by default) will move the cursor to the next indent point in the previous nonblank line, whereas `haskell-simple-indent-backtab' \ (bound to by default) will move the cursor the previous indent point. An indent point is a non-whitespace character following whitespace. Runs `haskell-simple-indent-hook' on activation." :lighter " Ind" :group 'haskell-simple-indent :keymap '(([backtab] . haskell-simple-indent-backtab)) (kill-local-variable 'comment-indent-function) (kill-local-variable 'indent-line-function) (when haskell-simple-indent-mode (set (make-local-variable 'comment-indent-function) #'haskell-simple-indent-comment-indent-function) (set (make-local-variable 'indent-line-function) 'haskell-simple-indent) (run-hooks 'haskell-simple-indent-hook))) ;; The main functions. ;;;###autoload (defun turn-on-haskell-simple-indent () "Turn on function `haskell-simple-indent-mode'." (interactive) (haskell-simple-indent-mode)) (defun turn-off-haskell-simple-indent () "Turn off function `haskell-simple-indent-mode'." (interactive) (haskell-simple-indent-mode 0)) ;; Provide ourselves: (provide 'haskell-simple-indent) ;;; haskell-simple-indent.el ends here haskell-mode-13.14.2/haskell-sort-imports.el000066400000000000000000000113341253441665600206720ustar00rootroot00000000000000;;; haskell-sort-imports.el --- Sort the list of Haskell imports at the point alphabetically ;; Copyright (C) 2010 Chris Done ;; Author: Chris Done ;; This file is not part of GNU Emacs. ;; This program is free software: you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as ;; published by the Free Software Foundation, either version 3 of ;; the License, or (at your option) any later version. ;; This program is distributed in the hope that it will be ;; useful, but WITHOUT ANY WARRANTY; without even the implied ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. See the GNU General Public License for more details. ;; You should have received a copy of the GNU General Public ;; License along with this program. If not, see ;; . ;;; Commentary: ;; If the region is active it sorts the imports within the ;; region. ;; This will align and sort the columns of the current import ;; list. It's more or less the coolest thing on the planet. ;;; Code: (defvar haskell-sort-imports-regexp (concat "^import[ ]+" "\\(qualified \\)?" "[ ]*\\(\"[^\"]*\" \\)?" "[ ]*\\([A-Za-z0-9_.']*.*\\)")) ;;;###autoload (defun haskell-sort-imports () "Sort the import list at point. It sorts the current group i.e. an import list separated by blank lines on either side. If the region is active, it will restrict the imports to sort within that region." (interactive) (when (haskell-sort-imports-at-import) (let* ((points (haskell-sort-imports-decl-points)) (current-string (buffer-substring-no-properties (car points) (cdr points))) (current-offset (- (point) (car points)))) (if (region-active-p) (progn (goto-char (region-beginning)) (haskell-sort-imports-goto-import-start)) (haskell-sort-imports-goto-group-start)) (let ((start (point)) (imports (haskell-sort-imports-collect-imports))) (delete-region start (point)) (mapc (lambda (import) (insert import "\n")) (sort imports (lambda (a b) (string< (haskell-sort-imports-normalize a) (haskell-sort-imports-normalize b))))) (goto-char start) (when (search-forward current-string nil t 1) (forward-char (- (length current-string))) (forward-char current-offset)))))) (defun haskell-sort-imports-normalize (i) "Normalize an import, if possible, so that it can be sorted." (if (string-match haskell-sort-imports-regexp i) (match-string 3 i) i)) (defun haskell-sort-imports-collect-imports () (let ((imports (list))) (while (looking-at "import") (let* ((points (haskell-sort-imports-decl-points)) (string (buffer-substring-no-properties (car points) (cdr points)))) (goto-char (min (1+ (cdr points)) (point-max))) (setq imports (cons string imports)))) (reverse (delq nil (delete-dups imports))))) (defun haskell-sort-imports-goto-group-start () "Go to the start of the import group." (or (and (search-backward "\n\n" nil t 1) (goto-char (+ 2 (line-end-position)))) (when (search-backward-regexp "^module " nil t 1) (goto-char (1+ (line-end-position)))) (goto-char (point-min)))) (defun haskell-sort-imports-at-import () "Are we at an import?" (save-excursion (haskell-sort-imports-goto-import-start) (looking-at "import"))) (defun haskell-sort-imports-goto-import-start () "Go to the start of the import." (goto-char (car (haskell-sort-imports-decl-points)))) (defun haskell-sort-imports-decl-points () "Get the points of the declaration." (save-excursion (let ((start (or (progn (goto-char (line-end-position)) (search-backward-regexp "^[^ \n]" nil t 1) (unless (or (looking-at "^-}$") (looking-at "^{-$")) (point))) 0)) (end (progn (goto-char (1+ (point))) (or (when (search-forward-regexp "[\n]+[^ \n]" nil t 1) (forward-char -1) (search-backward-regexp "[^\n ]" nil t) (line-end-position)) (when (search-forward-regexp "\n" nil t 1) (1- (point))) (point-max))))) (cons start end)))) (provide 'haskell-sort-imports) ;;; haskell-sort-imports.el ends here haskell-mode-13.14.2/haskell-string.el000066400000000000000000000202141253441665600175130ustar00rootroot00000000000000;;; haskell-string.el --- Haskell related string utilities ;; Copyright (C) 2013 Herbert Valerio Riedel ;; Author: Herbert Valerio Riedel ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;;; Todo: ;; - write ERT tests ;;; Code: (defun haskell-string-trim (string) "Remove whitespace around STRING. A Whitespace character is defined in the Haskell Report as follows whitechar -> newline | vertab | space | tab | uniWhite newline -> return linefeed | return | linefeed | formfeed uniWhite -> any Unicode character defined as whitespace Note: The implementation currently only supports ASCII white-space characters, i.e. the implemention doesn't consider uniWhite." (let ((s1 (if (string-match "[\t\n\v\f\r ]+\\'" string) (replace-match "" t t string) string))) (if (string-match "\\`[\t\n\v\f\r ]+" s1) (replace-match "" t t s1) s1))) (defun haskell-string-only-spaces-p (string) "Return t if STRING contains only whitespace (or is empty)." (string= "" (haskell-string-trim string))) (defun haskell-string-take (string n) "Return (up to) N character length prefix of STRING." (substring string 0 (min (length string) n))) (defconst haskell-string-literal-encode-ascii-array [ "\\NUL" "\\SOH" "\\STX" "\\ETX" "\\EOT" "\\ENQ" "\\ACK" "\\a" "\\b" "\\t" "\\n" "\\v" "\\f" "\\r" "\\SO" "\\SI" "\\DLE" "\\DC1" "\\DC2" "\\DC3" "\\DC4" "\\NAK" "\\SYN" "\\ETB" "\\CAN" "\\EM" "\\SUB" "\\ESC" "\\FS" "\\GS" "\\RS" "\\US" " " "!" "\\\"" "#" "$" "%" "&" "'" "(" ")" "*" "+" "," "-" "." "/" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" ":" ";" "<" "=" ">" "?" "@" "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" "[" "\\\\" "]" "^" "_" "`" "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z" "{" "|" "}" "~" "\\DEL" ] "Array of encodings for 7-bit ASCII character points indexed by ASCII value.") (defun haskell-string-literal-encode (str &optional no-quotes) "Encode STR according Haskell escape rules using 7-bit ASCII representation. The serialization has been implement to closely match the behaviour of GHC's Show instance for Strings. If NO-QUOTES is non-nil, omit wrapping result in quotes. This is the dual operation to `haskell-string-literal-decode'." (let ((lastc -1)) (let ((encode (lambda (c) (let ((lc lastc)) (setq lastc c) (if (>= c 128) ;; if non-ASCII code point (format "\\%d" c) ;; else, for ASCII code points (if (or (and (= lc 14) (= c ?H)) ;; "\SO\&H" (and (>= lc 128) (>= c ?0) (<= c ?9))) ;; "\123\&4" (concat "\\&" (aref haskell-string-literal-encode-ascii-array c)) (aref haskell-string-literal-encode-ascii-array c) )))))) (if no-quotes (mapconcat encode str "") (concat "\"" (mapconcat encode str "") "\""))))) (defconst haskell-string-literal-escapes-regexp (concat "[\\]\\(?:" (regexp-opt (append (mapcar (lambda (c) (format "%c" c)) "abfnrtv\\\"'&") ;; "charesc" escape sequences (mapcar (lambda (c) (format "^%c" c)) "ABCDEFGHIJKLMNOPQRSTUVWXYZ@[\\]^_") ;; "cntrl" escape sequences (mapcar (lambda (s) (format "%s" s)) (split-string "NUL SOH STX ETX EOT ENQ ACK BEL BS HT LF VT FF CR SO SI DLE DC1 DC2 DC3 DC4 NAK SYN ETB CAN EM SUB ESC FS GS RS US SP DEL")))) ;; "ascii" (w\o "cntrl") escape sequences "\\|" "[\t\n\v\f\r ]+[\\]" ;; whitespace gaps "\\|" "[0-9]+" ;; decimal escape sequence "\\|" "o[0-7]+" ;; octal escape sequence "\\|" "x[0-9a-f]+" ;; hex escape sequence "\\)?") ;; everything else is an invalid escape sequence "Regexp for matching escape codes in string literals. See Haskell Report Sect 2.6, URL `http://www.haskell.org/onlinereport/haskell2010/haskellch2.html#x7-200002.6', for more details.") (defconst haskell-string-literal-decode1-table (let ((h (make-hash-table :test 'equal))) (mapc (lambda (c) (puthash (concat "\\" (car c)) (cdr c) h)) '(;; ascii-escapes ("NUL" . "\x00") ("SOH" . "\x01") ("STX" . "\x02") ("ETX" . "\x03") ("EOT" . "\x04") ("ENQ" . "\x05") ("ACK" . "\x06") ("BEL" . "\x07") ("BS" . "\x08") ("HT" . "\x09") ("LF" . "\x0a") ("VT" . "\x0b") ("FF" . "\x0c") ("CR" . "\x0d") ("SO" . "\x0e") ("SI" . "\x0f") ("DLE" . "\x10") ("DC1" . "\x11") ("DC2" . "\x12") ("DC3" . "\x13") ("DC4" . "\x14") ("NAK" . "\x15") ("SYN" . "\x16") ("ETB" . "\x17") ("CAN" . "\x18") ("EM" . "\x19") ("SUB" . "\x1a") ("ESC" . "\x1b") ("FS" . "\x1c") ("GS" . "\x1d") ("RS" . "\x1e") ("US" . "\x1f") ("SP" . "\x20") ("DEL" . "\x7f" ) ;; C-compatible single-char escape sequences ("a" . "\x07") ("b" . "\x08") ("f" . "\x0c") ("n" . "\x0a") ("r" . "\x0d") ("t" . "\x09") ("v" . "\x0b") ;; trivial escapes ("\\" . "\\") ("\"" . "\"") ("'" . "'") ;; "empty" escape ("&" . ""))) h) "Hash table containing irregular escape sequences and their decoded strings. Used by `haskell-string-literal-decode1'.") (defun haskell-string-literal-decode1 (l) "Decode a single string literal escape sequence. L must contain exactly one escape sequence. This is an internal function used by `haskell-string-literal-decode'." (let ((case-fold-search nil)) (cond ((gethash l haskell-string-literal-decode1-table)) ((string-match "\\`[\\][0-9]+\\'" l) (char-to-string (string-to-number (substring l 1) 10))) ((string-match "\\`[\\]x[[:xdigit:]]+\\'" l) (char-to-string (string-to-number (substring l 2) 16))) ((string-match "\\`[\\]o[0-7]+\\'" l) (char-to-string (string-to-number (substring l 2) 8))) ((string-match "\\`[\\]\\^[@-_]\\'" l) (char-to-string (- (aref l 2) ?@))) ;; "cntrl" escapes ((string-match "\\`[\\][\t\n\v\f\r ]+[\\]\\'" l) "") ;; whitespace gap (t (error "Invalid escape sequence"))))) (defun haskell-string-literal-decode (estr &optional no-quotes) "Decode a Haskell string-literal. If NO-QUOTES is nil, ESTR must be surrounded by quotes. This is the dual operation to `haskell-string-literal-encode'." (if (and (not no-quotes) (string-match-p "\\`\"[^\\\"[:cntrl:]]*\"\\'" estr)) (substring estr 1 -1) ;; optimized fast-path for trivial strings (let ((s (if no-quotes ;; else: do general decoding estr (if (string-match-p "\\`\".*\"\\'" estr) (substring estr 1 -1) (error "String literal must be delimited by quotes")))) (case-fold-search nil)) (replace-regexp-in-string haskell-string-literal-escapes-regexp #'haskell-string-literal-decode1 s t t)))) (defun haskell-string-ellipsize (string n) "Return STRING truncated to (at most) N characters. If truncation occured, last character in string is replaced by `…'. See also `haskell-string-take'." (cond ((<= (length string) n) string) ;; no truncation needed ((< n 1) "") (t (concat (substring string 0 (1- n)) "…")))) (provide 'haskell-string) ;;; haskell-string.el ends here haskell-mode-13.14.2/haskell-unicode-input-method.el000066400000000000000000000204341253441665600222520ustar00rootroot00000000000000;;; haskell-unicode-input-method.el --- Haskell Unicode helper functions -*- coding: utf-8 -*- ;; Copyright (C) 2010-2011 Roel van Dijk ;; Author: Roel van Dijk ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;;; Code: (require 'quail) ;;;###autoload (defun turn-on-haskell-unicode-input-method () "Set input method `haskell-unicode'. See Info node `Unicode(haskell-mode)' for more details." (interactive) (set-input-method "haskell-unicode")) (quail-define-package "haskell-unicode" ;; name "UTF-8" ;; language "\\" ;; title t ;; guidance "Haskell Unicode input method. Designed to be used with the Haskell UnicodeSyntax language extension in combination with the x-unicode-symbols set of packages (base-unicode-symbols and containers-unicode-symbols). " ;; docstring nil ;; translation-keys nil ;; forget-last-selection nil ;; deterministic nil ;; kbd-translate nil ;; show-layout nil ;; create-decode-map nil ;; maximum-shortest nil ;; overlay-plist nil ;; update-translation-function nil ;; conversion-keys t ;; simple ) (quail-define-rules ;; Greek letters ("alpha " ["α"]) ("Alpha " ["Α"]) ("beta " ["β"]) ("Beta " ["Β"]) ("gamma " ["γ"]) ("Gamma " ["Γ"]) ("delta " ["δ"]) ("Delta " ["Δ"]) ("epsilon " ["ε"]) ("Epsilon " ["Ε"]) ("zeta " ["ζ"]) ("Zeta " ["Ζ"]) ("eta " ["η"]) ("Eta " ["Η"]) ("theta " ["θ"]) ("Theta " ["Θ"]) ("iota " ["ι"]) ("Iota " ["Ι"]) ("kappa " ["κ"]) ("Kappa " ["Κ"]) ("lambda " ["λ"]) ("Lambda " ["Λ"]) ("lamda " ["λ"]) ("Lamda " ["Λ"]) ("mu " ["μ"]) ("Mu " ["Μ"]) ("nu " ["ν"]) ("Nu " ["Ν"]) ("xi " ["ξ"]) ("Xi " ["Ξ"]) ("omicron " ["ο"]) ("Omicron " ["Ο"]) ("pi " ["π"]) ("Pi " ["Π"]) ("rho " ["ρ"]) ("Rho " ["Ρ"]) ("sigma " ["σ"]) ("Sigma " ["Σ"]) ("tau " ["τ"]) ("Tau " ["Τ"]) ("upsilon " ["υ"]) ("Upsilon " ["Υ"]) ("phi " ["φ"]) ("Phi " ["Φ"]) ("chi " ["χ"]) ("Chi " ["Χ"]) ("psi " ["ψ"]) ("Psi " ["Ψ"]) ("omega " ["ω"]) ("Omega " ["Ω"]) ("digamma " ["ϝ"]) ("Digamma " ["Ϝ"]) ("san " ["ϻ"]) ("San " ["Ϻ"]) ("qoppa " ["ϙ"]) ("Qoppa " ["Ϙ"]) ("sampi " ["ϡ"]) ("Sampi " ["Ϡ"]) ("stigma " ["ϛ"]) ("Stigma " ["Ϛ"]) ("heta " ["ͱ"]) ("Heta " ["Ͱ"]) ("sho " ["ϸ"]) ("Sho " ["Ϸ"]) ;; Double-struck letters ("|A|" ["𝔸"]) ("|B|" ["𝔹"]) ("|C|" ["ℂ"]) ("|D|" ["𝔻"]) ("|E|" ["𝔼"]) ("|F|" ["𝔽"]) ("|G|" ["𝔾"]) ("|H|" ["ℍ"]) ("|I|" ["𝕀"]) ("|J|" ["𝕁"]) ("|K|" ["𝕂"]) ("|L|" ["𝕃"]) ("|M|" ["𝕄"]) ("|N|" ["ℕ"]) ("|O|" ["𝕆"]) ("|P|" ["ℙ"]) ("|Q|" ["ℚ"]) ("|R|" ["ℝ"]) ("|S|" ["𝕊"]) ("|T|" ["𝕋"]) ("|U|" ["𝕌"]) ("|V|" ["𝕍"]) ("|W|" ["𝕎"]) ("|X|" ["𝕏"]) ("|Y|" ["𝕐"]) ("|Z|" ["ℤ"]) ("|gamma|" ["ℽ"]) ("|Gamma|" ["ℾ"]) ("|pi|" ["ℼ"]) ("|Pi|" ["ℿ"]) ;; Types ("::" ["∷"]) ;; Quantifiers ("forall" ["∀"]) ("exists" ["∃"]) ;; Arrows ("->" ["→"]) ;; ("-->" ["⟶"]) ("<-" ["←"]) ;; ("<--" ["⟵"]) ;; ("<->" ["↔"]) ;; ("<-->" ["⟷"]) ("=>" ["⇒"]) ;; ("==>" ["⟹"]) ;; ("<=" ["⇐"]) ;; ("<==" ["⟸"]) ;; ("<=>" ["⇔"]) ;; ("<==>" ["⟺"]) ;; ("|->" ["↦"]) ;; ("|-->" ["⟼"]) ;; ("<-|" ["↤"]) ;; ("<--|" ["⟻"]) ;; ("|=>" ["⤇"]) ;; ("|==>" ["⟾"]) ;; ("<=|" ["⤆"]) ;; ("<==|" ["⟽"]) ("~>" ["⇝"]) ;; ("~~>" ["⟿"]) ("<~" ["⇜"]) ;; ("<~~" ["⬳"]) ;; (">->" ["↣"]) ;; ("<-<" ["↢"]) ;; ("->>" ["↠"]) ;; ("<<-" ["↞"]) ;; (">->>" ["⤖"]) ;; ("<<-<" ["⬻"]) ;; ("<|-" ["⇽"]) ;; ("-|>" ["⇾"]) ;; ("<|-|>" ["⇿"]) ;; ("<-/-" ["↚"]) ;; ("-/->" ["↛"]) ;; ("<-|-" ["⇷"]) ;; ("-|->" ["⇸"]) ;; ("<-|->" ["⇹"]) ;; ("<-||-" ["⇺"]) ;; ("-||->" ["⇻"]) ;; ("<-||->" ["⇼"]) ;; ("-o->" ["⇴"]) ;; ("<-o-" ["⬰"]) ;; Boolean operators ;; ("not" ["¬"]) ("&&" ["∧"]) ("||" ["∨"]) ;; Relational operators ("==" ["≡"]) ("/=" ["≢" "≠"]) ("<=" ["≤"]) (">=" ["≥"]) ("/<" ["≮"]) ("/>" ["≯"]) ;; Arithmetic ;; (" / " [" ÷ "]) (" * " [" ⋅ "]) ;; Containers / Collections ;; ("++" ["⧺"]) ;; ("+++" ["⧻"]) ;; ("|||" ["⫴"]) ;; ("empty" ["∅"]) ("elem" ["∈"]) ("notElem" ["∉"]) ("member" ["∈"]) ("notMember" ["∉"]) ("union" ["∪"]) ("intersection" ["∩"]) ("isSubsetOf" ["⊆"]) ("isProperSubsetOf" ["⊂"]) ;; Other ;; ("<<" ["≪"]) ;; (">>" ["≫"]) ("<<<" ["⋘"]) (">>>" ["⋙"]) ("<|" ["⊲"]) ("|>" ["⊳"]) ("><" ["⋈"]) ;; ("mempty" ["∅"]) ("mappend" ["⊕"]) ;; ("<*>" ["⊛"]) (" . " [" ∘ "]) ("undefined" ["⊥"]) (":=" ["≔"]) ("=:" ["≕"]) ("=def" ["≝"]) ("=?" ["≟"]) ("..." ["…"]) ;; Braces ;; ("[|" ["〚"]) ;; ("|]" ["〛"]) ;; Numeric subscripts ("_0 " ["₀"]) ("_1 " ["₁"]) ("_2 " ["₂"]) ("_3 " ["₃"]) ("_4 " ["₄"]) ("_5 " ["₅"]) ("_6 " ["₆"]) ("_7 " ["₇"]) ("_8 " ["₈"]) ("_9 " ["₉"]) ;; Numeric superscripts ("^0 " ["⁰"]) ("^1 " ["¹"]) ("^2 " ["²"]) ("^3 " ["³"]) ("^4 " ["⁴"]) ("^5 " ["⁵"]) ("^6 " ["⁶"]) ("^7 " ["⁷"]) ("^8 " ["⁸"]) ("^9 " ["⁹"]) ) (provide 'haskell-unicode-input-method) ;;; haskell-unicode-input-method.el ends here haskell-mode-13.14.2/haskell-utils.el000066400000000000000000000053071253441665600173530ustar00rootroot00000000000000;;; haskell-utils.el --- General utility functions used by haskell-mode modules ;; Copyright (C) 2013 Herbert Valerio Riedel ;; Author: Herbert Valerio Riedel ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3 of the License, or ;; (at your option) any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; This module's purpose is to provide a place for helper functions ;; which are general enough to be usable by multiple modules and/or ;; to alleviate circular module dependency problems. ;; ;; When possible, functions in this module shall be accompanied by ;; ERT-based unit tests. ;; ;; See also `haskell-str.el' for string utility functions. ;; ;; All symbols in this module have a `haskell-utils-' prefix. ;;; Code: ;; NOTE: This module is supposed to be a leaf-module and shall not ;; require/depend-on any other haskell-mode modules in order to ;; stay at the bottom of the module dependency graph. (defun haskell-utils-read-directory-name (prompt default) "Read directory name and normalize to true absolute path. Refer to `read-directory-name' for the meaning of PROMPT and DEFAULT." (let ((filename (file-truename (read-directory-name prompt default default)))) (concat (replace-regexp-in-string "/$" "" filename) "/"))) (defun haskell-utils-parse-import-statement-at-point () "Return imported module name if on import statement or nil otherwise. This currently assumes that the \"import\" keyword and the module name are on the same line. This function supports the SafeHaskell and PackageImports syntax extensions. Note: doesn't detect if in {--}-style comment." (save-excursion (goto-char (line-beginning-position)) (if (looking-at (concat "[\t ]*import[\t ]+" "\\(?:safe[\t ]+\\)?" ;; SafeHaskell "\\(?:qualified[\t ]+\\)?" "\\(?:\"[^\"]*\"[\t ]+\\)?" ;; PackageImports "\\([[:digit:][:upper:][:lower:]_.]+\\)")) (match-string-no-properties 1)))) (provide 'haskell-utils) ;;; haskell-utils.el ends here haskell-mode-13.14.2/haskell.el000066400000000000000000000502321253441665600162120ustar00rootroot00000000000000;;; haskell.el --- Top-level Haskell package ;; Copyright (c) 2014 Chris Done. All rights reserved. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: (require 'cl-lib) (require 'haskell-mode) (require 'haskell-process) (require 'haskell-debug) (require 'haskell-interactive-mode) (require 'haskell-repl) (require 'haskell-load) (require 'haskell-commands) (require 'haskell-sandbox) (require 'haskell-modules) (require 'haskell-string) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Basic configuration hooks (add-hook 'haskell-process-ended-hook 'haskell-process-prompt-restart) (add-hook 'kill-buffer-hook 'haskell-interactive-kill) (defvar interactive-haskell-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-l") 'haskell-process-load-or-reload) (define-key map (kbd "C-c C-t") 'haskell-process-do-type) (define-key map (kbd "C-c C-i") 'haskell-process-do-info) (define-key map (kbd "M-.") 'haskell-mode-jump-to-def-or-tag) (define-key map (kbd "C-c C-k") 'haskell-interactive-mode-clear) (define-key map (kbd "C-c C-c") 'haskell-process-cabal-build) (define-key map (kbd "C-c C-x") 'haskell-process-cabal) (define-key map [?\C-c ?\C-b] 'haskell-interactive-switch) (define-key map [?\C-c ?\C-z] 'haskell-interactive-switch) map) "Keymap for using haskell-interactive-mode.") ;;;###autoload (define-minor-mode interactive-haskell-mode "Minor mode for enabling haskell-process interaction." :lighter " Interactive" :keymap interactive-haskell-mode-map (add-hook 'completion-at-point-functions 'haskell-process-completions-at-point nil t)) (defun haskell-process-completions-at-point () "A completion-at-point function using the current haskell process." (when (haskell-session-maybe) (let ((process (haskell-process)) symbol symbol-bounds) (cond ;; ghci can complete module names, but it needs the "import " ;; string at the beginning ((looking-back (rx line-start "import" (1+ space) (? "qualified" (1+ space)) (group (? (char upper) ; modid (* (char alnum ?' ?.))))) (line-beginning-position)) (let ((text (match-string-no-properties 0)) (start (match-beginning 1)) (end (match-end 1))) (list start end (haskell-process-get-repl-completions process text)))) ;; Complete OPTIONS using :complete repl ":set ..." ((and (nth 4 (syntax-ppss)) (save-excursion (let ((p (point))) (and (search-backward "{-#" nil t) (search-forward-regexp "\\_" p t)))) (looking-back (rx symbol-start "-" (* (char alnum ?-))) (line-beginning-position))) (list (match-beginning 0) (match-end 0) haskell-ghc-supported-options)) ;; Complete LANGUAGE :complete repl ":set -X..." ((and (nth 4 (syntax-ppss)) (save-excursion (let ((p (point))) (and (search-backward "{-#" nil t) (search-forward-regexp "\\_" p t)))) (setq symbol-bounds (bounds-of-thing-at-point 'symbol))) (list (car symbol-bounds) (cdr symbol-bounds) haskell-ghc-supported-extensions)) ((setq symbol-bounds (haskell-ident-pos-at-point)) (cl-destructuring-bind (start . end) symbol-bounds (list start end (haskell-process-get-repl-completions process (buffer-substring-no-properties start end))))))))) ;;;###autoload (defun haskell-interactive-mode-return () "Handle the return key." (interactive) (cond ((haskell-interactive-at-compile-message) (next-error-internal)) (t (haskell-interactive-handle-expr)))) ;;;###autoload (defun haskell-session-kill (&optional leave-interactive-buffer) "Kill the session process and buffer, delete the session. 0. Prompt to kill all associated buffers. 1. Kill the process. 2. Kill the interactive buffer. 3. Walk through all the related buffers and set their haskell-session to nil. 4. Remove the session from the sessions list." (interactive) (let* ((session (haskell-session)) (name (haskell-session-name session)) (also-kill-buffers (and haskell-ask-also-kill-buffers (y-or-n-p (format "Killing `%s'. Also kill all associated buffers?" name))))) (haskell-kill-session-process session) (unless leave-interactive-buffer (kill-buffer (haskell-session-interactive-buffer session))) (cl-loop for buffer in (buffer-list) do (with-current-buffer buffer (when (and (boundp 'haskell-session) (string= (haskell-session-name haskell-session) name)) (setq haskell-session nil) (when also-kill-buffers (kill-buffer))))) (setq haskell-sessions (cl-remove-if (lambda (session) (string= (haskell-session-name session) name)) haskell-sessions)))) ;;;###autoload (defun haskell-interactive-kill () "Kill the buffer and (maybe) the session." (interactive) (when (eq major-mode 'haskell-interactive-mode) (when (and (boundp 'haskell-session) haskell-session (y-or-n-p "Kill the whole session?")) (haskell-session-kill t)))) (defun haskell-session-make (name) "Make a Haskell session." (when (haskell-session-lookup name) (error "Session of name %s already exists!" name)) (let ((session (setq haskell-session (list (cons 'name name))))) (add-to-list 'haskell-sessions session) (haskell-process-start session) session)) (defun haskell-session-new-assume-from-cabal () "Prompt to create a new project based on a guess from the nearest Cabal file." (let ((name (haskell-session-default-name))) (unless (haskell-session-lookup name) (when (y-or-n-p (format "Start a new project named “%s”? " name)) (haskell-session-make name))))) ;;;###autoload (defun haskell-session () "Get the Haskell session, prompt if there isn't one or fail." (or (haskell-session-maybe) (haskell-session-assign (or (haskell-session-from-buffer) (haskell-session-new-assume-from-cabal) (haskell-session-choose) (haskell-session-new))))) ;;;###autoload (defun haskell-interactive-switch () "Switch to the interactive mode for this session." (interactive) (let ((initial-buffer (current-buffer)) (buffer (haskell-session-interactive-buffer (haskell-session)))) (with-current-buffer buffer (setq haskell-interactive-previous-buffer initial-buffer)) (unless (eq buffer (window-buffer)) (switch-to-buffer-other-window buffer)))) (defun haskell-session-new () "Make a new session." (let ((name (read-from-minibuffer "Project name: " (haskell-session-default-name)))) (when (not (string= name "")) (let ((session (haskell-session-lookup name))) (if session (when (y-or-n-p (format "Session %s already exists. Use it?" name)) session) (haskell-session-make name)))))) ;;;###autoload (defun haskell-session-change () "Change the session for the current buffer." (interactive) (haskell-session-assign (or (haskell-session-new-assume-from-cabal) (haskell-session-choose) (haskell-session-new)))) (defun haskell-process-prompt-restart (process) "Prompt to restart the died process." (let ((process-name (haskell-process-name process))) (if haskell-process-suggest-restart (cond ((string-match "You need to re-run the 'configure' command." (haskell-process-response process)) (cl-case (read-event (concat "The Haskell process ended. Cabal wants you to run " (propertize "cabal configure" 'face 'font-lock-keyword-face) " because there is a version mismatch. Re-configure (y, n, l: view log)?" "\n\n" "Cabal said:\n\n" (propertize (haskell-process-response process) 'face 'font-lock-comment-face))) (?y (let ((default-directory (haskell-session-cabal-dir (haskell-process-session process)))) (message "%s" (shell-command-to-string "cabal configure")))) (?l (let* ((response (haskell-process-response process)) (buffer (get-buffer "*haskell-process-log*"))) (if buffer (switch-to-buffer buffer) (progn (switch-to-buffer (get-buffer-create "*haskell-process-log*")) (insert response))))) (?n))) (t (cl-case (read-event (propertize (format "The Haskell process `%s' has died. Restart? (y, n, l: show process log)" process-name) 'face 'minibuffer-prompt)) (?y (haskell-process-start (haskell-process-session process))) (?l (let* ((response (haskell-process-response process)) (buffer (get-buffer "*haskell-process-log*"))) (if buffer (switch-to-buffer buffer) (progn (switch-to-buffer (get-buffer-create "*haskell-process-log*")) (insert response))))) (?n)))) (message (format "The Haskell process `%s' is dearly departed." process-name))))) (defun haskell-process () "Get the current process from the current session." (haskell-session-process (haskell-session))) (defun haskell-interactive-buffer () "Get the interactive buffer of the session." (haskell-session-interactive-buffer (haskell-session))) ;;;###autoload (defun haskell-kill-session-process (&optional session) "Kill the process." (interactive) (let* ((session (or session (haskell-session))) (existing-process (get-process (haskell-session-name session)))) (when (processp existing-process) (haskell-interactive-mode-echo session "Killing process ...") (haskell-process-set (haskell-session-process session) 'is-restarting t) (delete-process existing-process)))) ;;;###autoload (defun haskell-interactive-mode-visit-error () "Visit the buffer of the current (or last) error message." (interactive) (with-current-buffer (haskell-session-interactive-buffer (haskell-session)) (if (progn (goto-char (line-beginning-position)) (looking-at haskell-interactive-mode-error-regexp)) (progn (forward-line -1) (haskell-interactive-jump-to-error-line)) (progn (goto-char (point-max)) (haskell-interactive-mode-error-backward) (haskell-interactive-jump-to-error-line))))) ;;;###autoload (defun haskell-mode-contextual-space () "Contextually do clever stuff when hitting space." (interactive) (if (or (not (bound-and-true-p interactive-haskell-mode)) (not (haskell-session-maybe))) (self-insert-command 1) (cond ((and haskell-mode-contextual-import-completion (save-excursion (forward-word -1) (looking-at "^import$"))) (insert " ") (let ((module (haskell-complete-module-read "Module: " (haskell-session-all-modules (haskell-session))))) (let ((mapping (assoc module haskell-import-mapping))) (if mapping (progn (delete-region (line-beginning-position) (line-end-position)) (insert (cdr mapping))) (insert module))) (haskell-mode-format-imports))) (t (let ((ident (save-excursion (forward-char -1) (haskell-ident-at-point)))) (insert " ") (when ident (haskell-process-do-try-info ident))))))) ;;;###autoload (defun haskell-mode-jump-to-tag (&optional next-p) "Jump to the tag of the given identifier." (interactive "P") (let ((ident (haskell-ident-at-point)) (tags-file-name (haskell-session-tags-filename (haskell-session))) (tags-revert-without-query t)) (when (and ident (not (string= "" (haskell-string-trim ident)))) (cond ((file-exists-p tags-file-name) (let ((xref-prompt-for-identifier next-p)) (xref-find-definitions ident))) (t (haskell-process-generate-tags ident)))))) ;;;###autoload (defun haskell-mode-after-save-handler () "Function that will be called after buffer's saving." (when haskell-tags-on-save (ignore-errors (when (and (boundp 'haskell-session) haskell-session) (haskell-process-generate-tags)))) (when haskell-stylish-on-save (ignore-errors (haskell-mode-stylish-buffer)) (let ((before-save-hook '()) (after-save-hook '())) (basic-save-buffer)))) ;;;###autoload (defun haskell-mode-tag-find (&optional next-p) "The tag find function, specific for the particular session." (interactive "P") (cond ((elt (syntax-ppss) 3) ;; Inside a string (haskell-mode-jump-to-filename-in-string)) (t (call-interactively 'haskell-mode-jump-to-tag)))) (defun haskell-mode-jump-to-filename-in-string () "Jump to the filename in the current string." (let* ((string (save-excursion (buffer-substring-no-properties (1+ (search-backward-regexp "\"" (line-beginning-position) nil 1)) (1- (progn (forward-char 1) (search-forward-regexp "\"" (line-end-position) nil 1)))))) (fp (expand-file-name string (haskell-session-cabal-dir (haskell-session))))) (find-file (read-file-name "" fp fp)))) ;;;###autoload (defun haskell-interactive-bring () "Bring up the interactive mode for this session." (interactive) (let* ((session (haskell-session)) (buffer (haskell-session-interactive-buffer session))) (unless (and (cl-find-if (lambda (window) (equal (window-buffer window) buffer)) (window-list)) (= 2 (length (window-list)))) (delete-other-windows) (display-buffer buffer) (other-window 1)))) ;;;###autoload (defun haskell-process-load-file () "Load the current buffer file." (interactive) (save-buffer) (haskell-interactive-mode-reset-error (haskell-session)) (haskell-process-file-loadish (format "load \"%s\"" (replace-regexp-in-string "\"" "\\\\\"" (buffer-file-name))) nil (current-buffer))) ;;;###autoload (defun haskell-process-reload-file () "Re-load the current buffer file." (interactive) (save-buffer) (haskell-interactive-mode-reset-error (haskell-session)) (haskell-process-file-loadish "reload" t nil)) ;;;###autoload (defun haskell-process-load-or-reload (&optional toggle) "Load or reload. Universal argument toggles which." (interactive "P") (if toggle (progn (setq haskell-reload-p (not haskell-reload-p)) (message "%s (No action taken this time)" (if haskell-reload-p "Now running :reload." "Now running :load ."))) (if haskell-reload-p (haskell-process-reload-file) (haskell-process-load-file)))) ;;;###autoload (defun haskell-process-cabal-build () "Build the Cabal project." (interactive) (haskell-process-do-cabal "build") (haskell-process-add-cabal-autogen)) ;;;###autoload (defun haskell-process-cabal (p) "Prompts for a Cabal command to run." (interactive "P") (if p (haskell-process-do-cabal (read-from-minibuffer "Cabal command (e.g. install): ")) (haskell-process-do-cabal (funcall haskell-completing-read-function "Cabal command: " (append haskell-cabal-commands (list "build --ghc-options=-fforce-recomp")))))) (defun haskell-process-file-loadish (command reload-p module-buffer) "Run a loading-ish COMMAND that wants to pick up type errors and things like that. RELOAD-P indicates whether the notification should say 'reloaded' or 'loaded'. MODULE-BUFFER may be used for various things, but is optional." (let ((session (haskell-session))) (haskell-session-current-dir session) (when haskell-process-check-cabal-config-on-load (haskell-process-look-config-changes session)) (let ((process (haskell-process))) (haskell-process-queue-command process (make-haskell-command :state (list session process command reload-p module-buffer) :go (lambda (state) (haskell-process-send-string (cadr state) (format ":%s" (cl-caddr state)))) :live (lambda (state buffer) (haskell-process-live-build (cadr state) buffer nil)) :complete (lambda (state response) (haskell-process-load-complete (car state) (cadr state) response (cl-cadddr state) (cl-cadddr (cdr state))))))))) ;;;###autoload (defun haskell-process-minimal-imports () "Dump minimal imports." (interactive) (unless (> (save-excursion (goto-char (point-min)) (haskell-navigate-imports-go) (point)) (point)) (goto-char (point-min)) (haskell-navigate-imports-go)) (haskell-process-queue-sync-request (haskell-process) ":set -ddump-minimal-imports") (haskell-process-load-file) (insert-file-contents-literally (concat (haskell-session-current-dir (haskell-session)) "/" (haskell-guess-module-name) ".imports"))) (defun haskell-interactive-jump-to-error-line () "Jump to the error line." (let ((orig-line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) (and (string-match "^\\([^:]+\\):\\([0-9]+\\):\\([0-9]+\\)\\(-[0-9]+\\)?:" orig-line) (let* ((file (match-string 1 orig-line)) (line (match-string 2 orig-line)) (col (match-string 3 orig-line)) (session (haskell-interactive-session)) (cabal-path (haskell-session-cabal-dir session)) (src-path (haskell-session-current-dir session)) (cabal-relative-file (expand-file-name file cabal-path)) (src-relative-file (expand-file-name file src-path))) (let ((file (cond ((file-exists-p cabal-relative-file) cabal-relative-file) ((file-exists-p src-relative-file) src-relative-file)))) (when file (other-window 1) (find-file file) (haskell-interactive-bring) (goto-char (point-min)) (forward-line (1- (string-to-number line))) (goto-char (+ (point) (string-to-number col) -1)) (haskell-mode-message-line orig-line) t)))))) (provide 'haskell) haskell-mode-13.14.2/highlight-uses-mode.el000066400000000000000000000076441253441665600204460ustar00rootroot00000000000000;;; highlight-uses-mode.el --- Mode for highlighting uses ;; Copyright (c) 2014 Chris Done. All rights reserved. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: (require 'cl-lib) (defvar highlight-uses-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "TAB") 'highlight-uses-mode-next) (define-key map (kbd "S-TAB") 'highlight-uses-mode-prev) (define-key map (kbd "") 'highlight-uses-mode-prev) (define-key map (kbd "RET") 'highlight-uses-mode-stop-here) (define-key map (kbd "C-g") 'highlight-uses-mode) map) "Keymap for using haskell-interactive-mode.") (defvar highlight-uses-mode-point nil) (make-variable-buffer-local 'highlight-uses-mode-point) ;;;###autoload (define-minor-mode highlight-uses-mode "Minor mode for highlighting and jumping between uses." :lighter " Uses" :keymap highlight-uses-mode-map (if highlight-uses-mode (setq highlight-uses-mode-point (point)) (when highlight-uses-mode-point (goto-char highlight-uses-mode-point))) (remove-overlays (point-min) (point-max) 'highlight-uses-mode-highlight t)) (defun highlight-uses-mode-replace () "Replace all highlighted instances in the buffer with something else." (interactive) (save-excursion (goto-char (point-min)) (let ((o (highlight-uses-mode-next))) (when o (let ((replacement (read-from-minibuffer (format "Replace uses %s with: " (buffer-substring (overlay-start o) (overlay-end o)))))) (while o (goto-char (overlay-start o)) (delete-region (overlay-start o) (overlay-end o)) (insert replacement) (setq o (highlight-uses-mode-next)))))))) (defun highlight-uses-mode-stop-here () "Stop at this point." (interactive) (setq highlight-uses-mode-point (point)) (highlight-uses-mode -1)) (defun highlight-uses-mode-next () "Jump to next result." (interactive) (let ((os (sort (cl-remove-if (lambda (o) (or (<= (overlay-start o) (point)) (not (overlay-get o 'highlight-uses-mode-highlight)))) (overlays-in (point) (point-max))) (lambda (a b) (< (overlay-start a) (overlay-start b)))))) (when os (goto-char (overlay-start (car os))) (car os)))) (defun highlight-uses-mode-prev () "Jump to previous result." (interactive) (let ((os (sort (cl-remove-if (lambda (o) (or (>= (overlay-end o) (point)) (not (overlay-get o 'highlight-uses-mode-highlight)))) (overlays-in (point-min) (point))) (lambda (a b) (> (overlay-start a) (overlay-start b)))))) (when os (goto-char (overlay-start (car os))) (car os)))) (defun highlight-uses-mode-highlight (start end) "Make a highlight overlay at the given span." (let ((o (make-overlay start end))) (overlay-put o 'priority 999) (overlay-put o 'face 'isearch) (overlay-put o 'highlight-uses-mode-highlight t))) (provide 'highlight-uses-mode) haskell-mode-13.14.2/images/000077500000000000000000000000001253441665600155105ustar00rootroot00000000000000haskell-mode-13.14.2/images/haskell-mode-128x128.png000066400000000000000000000442501253441665600215230ustar00rootroot00000000000000PNG  IHDR>a AiCCPICC ProfileH wTSϽ7" %z ;HQIP&vDF)VdTG"cE b PQDE݌k 5ޚYg}׺PtX4X\XffGD=HƳ.d,P&s"7C$ E6<~&S2)212 "įl+ɘ&Y4Pޚ%ᣌ\%g|eTI(L0_&l2E9r9hxgIbטifSb1+MxL 0oE%YmhYh~S=zU&ϞAYl/$ZUm@O ޜl^ ' lsk.+7oʿ9V;?#I3eE妧KD d9i,UQ h A1vjpԁzN6p\W p G@ K0ށiABZyCAP8C@&*CP=#t] 4}a ٰ;GDxJ>,_“@FXDBX$!k"EHqaYbVabJ0՘cVL6f3bձX'?v 6-V``[a;p~\2n5׌ &x*sb|! ߏƿ' Zk! $l$T4QOt"y\b)AI&NI$R$)TIj"]&=&!:dGrY@^O$ _%?P(&OJEBN9J@y@yCR nXZOD}J}/G3ɭk{%Oחw_.'_!JQ@SVF=IEbbbb5Q%O@%!BӥyҸM:e0G7ӓ e%e[(R0`3R46i^)*n*|"fLUo՝mO0j&jajj.ϧwϝ_4갺zj=U45nɚ4ǴhZ ZZ^0Tf%9->ݫ=cXgN].[7A\SwBOK/X/_Q>QG[ `Aaac#*Z;8cq>[&IIMST`ϴ kh&45ǢYYF֠9<|y+ =X_,,S-,Y)YXmĚk]c}džjcΦ浭-v};]N"&1=xtv(}'{'IߝY) Σ -rqr.d._xpUەZM׍vm=+KGǔ ^WWbj>:>>>v}/avO8 FV> 2 u/_$\BCv< 5 ]s.,4&yUx~xw-bEDCĻHGKwFGEGME{EEKX,YFZ ={$vrK .3\rϮ_Yq*©L_wד+]eD]cIIIOAu_䩔)3ѩiB%a+]3='/40CiU@ёL(sYfLH$%Y jgGeQn~5f5wugv5k֮\۹Nw]m mHFˍenQQ`hBBQ-[lllfjۗ"^bO%ܒY}WwvwXbY^Ю]WVa[q`id2JjGէ{׿m>PkAma꺿g_DHGGu;776ƱqoC{P38!9 ҝˁ^r۽Ug9];}}_~imp㭎}]/}.{^=}^?z8hc' O*?f`ϳgC/Oϩ+FFGGόzˌㅿ)ѫ~wgbk?Jި9mdwi獵ޫ?cǑOO?w| x&mf2:Y~ pHYsTTyJdiTXtXML:com.adobe.xmp www.inkscape.org Ǧm( 6coO?Ҙ\{_9Ozo &s}g wCo4,q{ȲNif'UkRg!qifw*4فj>3g̴ITrw͐zVmnJ@3d|uʍ4y Ƥ茻f$Í4YB7fy t&@rgJLE6O8/LgEž1.4CCR64q@;pB-H`\N}`.KS\ؿIK(m L˚yqRFox.06.qt 3d^qGϟ??iڵf*..NOOJHHHMwѳ}___gwwwKGGGKSSS}EEEݑ#G7m԰6devq; l ! R qd ] 4vfzxddd]wݕΙ3g~fffi|||^tttzDDDX>hppСCO>N-!@DdЎ |)+p,]UY !ٞv4:C]4{w%(((XX`; EW{{][nc(//? B(C)cߌ#9 ׊U$2B>=ӟλk]Y>JANVVVn}W޺7 t<D ' }P'07e3r [bEC=vw B q#Ϟ=w|M۶mG} "H(HDa66άx"g:)3]tu?|SLPWu>ӯz{ W.bcTBbV**Jwg4MӐ^|7K݅I2 n"PwC@xR7C2gu<7AR{vQL>&0j$=0b I@D5%7E 1v H]ij{ 7oq$@$ 2"'$ [G'/SJOROI=,...[e݉_?h}}:U٨jjZTN=˙F  _4CR'CjZIQE*++I~P-[ӟƮ eD;5P$8ǡA7;!YO{G~_vVV޴v zЮ-c& ]d⩙*99"'x_x='K/l5ৱ̸-!=Oro|:g}D^^^҆ X`.+9ӬRէ4ɻ/,AdRyjK]{}n}uu5L$B "[J@3:(}8ܧzӧ^{g0tUzrkIء'Ў}@ߵPԩSuuZLJߚn[GKhDH[۟us3^I= 3tz ׭_P˦x-'TuuNtRTtYyƍvM7'oܹڶ90(GI C#Жa͚5 7؁ x;, y(GCB QyG{g -S{rz֞Y.qOkĐ́暚 ('$0jT9 =O0g>z1qv Oqc板RGk/ A#1s~*{F9z^Vo,YF.2*D<wbk|"i~o…wڛAf܁ouT2JY"1ԩ4m`[ |wu䨵:gϞ.Z\ v PYd. t[ N 8&nu+%R,S?7e.wA]rP.l2 M\;V#5z|!u$\~,?s|8ۣM܀tN82 G7T@/7>?w;vqڽl޻5VXJLTI*/7M1S}}xEi^? @Ҙ9fA}ںUss^'Q86eaçMq PIx?z S_bp?vamyc7~0@$T}ݘECxlUqq6=Ta6krܫ ^9䠥kfY;^EV@v@ HhJ?Bx>I}s[o}uƌ[ΛonIFiʕٞZZzcgΝՎA*jn[~YXԩFMƗumZHhf:Zj7vc@fDsno?iv_^c@hhAAF@1D^-g X]ҒEW  sQQ@xu%ChnupJ*TRRTC.S-*<+kT)Zv1;5eʔ901u, # # #0M_lFرc02^ 4UI\8>%9;Go&%j$̽j aڭd0f#Ҿ8ԍq`= V=UZVNZMkӧqD.A@ Šy8!<"L%ǨXaq Q*;!Dz8ç{`֭[ ~?`A:d,y~!@ͪ-r3YhfcEDR{RZj:eUyY=< ǒcz%V@_"0R! x 8ɟ3f'?|hn>=U|xGuvvkv}hs,9[#  dHXf& !s GnfEY%{U}4 %YSP} M\qsL9zd a@XHH`:!5|/^ bҥY8#zj;U٤*T Y}z&cd2U3QQ1" `L9c#,{` S'YTZ< 1{'̶)iA!@BjᢩXΫϞmUUU5Xuj ul?2P~ ({c!lt`~ɫoT 7Xy d:!c\T,$,?=*e#CtC"˗_] lqXDgz&@[{Ֆ'/ UkoTO5rH#q Rjyj,p b9)P gl\S#h7JVvR&=VcٗØ3@1X`l:>vFf?. ;kG-q`5LkGV\$3C8R΄~^7id)(Q"e){cOB/^ Fd%"KDǸ)SY&B)5ɛgna޼5kN -Ao/eh 8*8v L!褐_(@3]U *RZUoxxziN֪dߵRS {H %Xs삌@E $vQ  BƩegBxXّ#Po~ RJO"ǘc1g& {B>tB]wu%%%iŗJj7T) 2{nVJp@"]eTWG `P+Ĝ!NHƖq*(S))9(Ki5  ߎ-}x8ahaC!]&ի3c:, PEFď^zg%:ݍdd#Xfٺ&?|X+ܥǫCdAmf8"asHTWý>` ) jˎT#Vkf8͋x ,+kǫZ8$)Y&Y34bT?X {kϿYM7/yyNAcF_ٝݷV 6}:цg Q*) ɍx|0N8si^p:WO1; ~1߉_}PB+ (8Q@:Ƅf0AhS5'66^q 5 z\|0 H E^6/ ,d t/RLDQk֬aEJgv1߅׀9y6 l_;T(&q)%]=Wk>q2cKikW_SA]֖Dz9.ήhj:| ^m/v.pl k/4gXUv6ڞf)zE%Kp?a&l%ye={v&yhvxD=Kd&gS3q#Y_N>pZSI&HuT~MA[ԇ+9z;w/ ds;!q;wd>jkIP9ևd9y|upZjhoこKVMSoVB:ޣfc cu,K֪}Չ#3,4,>JwAOSA=[}g1Oi3qgNw.IH\ZG UW{CMzRlll5@Ш°WpfW|jDh!,ӣ'ˀah"|NJpWbg 6_+F#<<d;33 ʒB5&x: #aŚlz0(%SXeT>l-@~`T<5Q:Vj0(gV_~ եjFH&Vu"oVW9)3gg[Xͤhwߩ[w8d`y@:̼!X1h.g)W^6l^XݐȰ ~S 03g?l=q' /=3Uncwi,@ϥ9_B=_f]6>' $B=m0+v))tYA KT@tlC S6:7 LuuW'z;7L$LzaTgs 8g 13mF#*IMKKPw ګԻy>)^EcUr^PFZBVP|[18GgR0"R5axG379^*爸dFa{ 7̴ ggZcOAB HO؛'OLQeɄV扠n ~CL}^d^!OҜB[xX,ըl]P\Lp~/4'㛡 *k8*8UGrZ1a.^} h26&>ł/WDC~ݹa& "'dd$og}ly1l|sv*UVV z%! 8:4!!<!qyh4TIPOu>k++UF:QɑdZ tSYU&\7 Kam,\&~{=g `G\wfa7^ vջNtiKdфK TZ1?j SW!]3z3hZL5A Q0Kd&4A`@FA D]h DwW'\? =bj;Cc,80TBf嗷 ]h*gv@no~e< C0KM./q;H&kD;ۯ2|lOG4B=S*Z(o,VщZlN|; 5++zu *zTAdب%P" rf&sTu&fu :uEd,Izm[edqGiOG|8~tf6OwE%pӹڭ` DKẄ́7U gw4㒲"< "9 :1̸F_Zc~ ڟ)TXnc;V+fG.(gdu#HyMKs+z;I6xIQ.)UwUk?- V_9C <aO[12Fx͍oL* f2*]ɨ>k!9%Vk8CFx{[NglyxI>wޝ}eI3|RB (8tcg-Vޥ^z}DT)YXɀuj `dӦBD.ktJ`0 ,LGXf4/Xi:j"M~z.5y:cakG-q OrƛJ *u+;ۯ=%|4Q1ӠyBg z@> EZ!ea3L{5teςJ5/6BF%  V;Mh֓ݎ|afdaAޗ/H;3q>!>Ym ^/|^o]D{ 1pXиs(1 3fs̾2km R4[Ij q** P;p?XkJa` HsS{Ǟ0;Š0C:aa`LKaVЋ{z9ZX,9#=zЫ|/R:0ʄ"e&h8ș,{e $5\ҫ>>q&D_?UY"+7M/UsiVI9& +lΎ 0|xJ#4/j{>@*>>ߤ~^ ]aa­5.S3gfcEXP ˟A׺Bv l;U-YcKd>3"l%+pg؃Vv e"JǜcO؝V^}ަ=x"iaOAa8\ArrڷM4]OPd$ h/ZP@I hYGGaHhH`{_4 Ɔpl:}T/6+ 븾7'l P1b|E1jL+H"M*DM˪vdkn%sv!{4giw8:~FdEW}o@ͮH=3o7S7܋;Zysuno54x 3ռw?~!svZ5$?M4v^xy9P+!/Z'y0@;7@ۉ `EDXW}b>U &Fl%**BaGL¬>bpJvɣ uʏ8wWbmz[8Foqѷj9he4q%%%? qo~X;='1Ԉ@K:S)sťI5_)7ԪтMm[G"lҔ'H,! g Kwp7Ferټ@=@Aq9tܜ̟2ձʋ.(\&zZL/_F0$:p8}=B#?ڨyA/Aj==N2FlذM;,f,;2{nA^]`}Mji|X',owagG⣓ 4fhdI?_/$%W\a|G%f>>,-(_< NA*|6(jEsYPR Pጻ h<\ԣ% ;*G2!A I͓aФEbi@Ll H 7[mXhR<%?±3ogz//$rGf?‡Y1 ۷|5x!,-x;H RL͆>e)T {}l{[NAp/KK@YXLo>~Gq{᛭#'aB A ~P/` HAommTwIE BDhP+72h$I!Ǫ\-l KHO3WZ7#3|YXxqw`38}K"J/1v wv ٢#X$H0szl6l⋿a8g hcT37 BL 8/?FWw2?iGY' 6wTS#RerO ,;8qσ΅clwat-| Q rj\=І3op7ݼ4y} Y@[X ײfs66`5p;[ԱM0("8A0sl9Ʀ_=aN3~ |']'YS>N4\R/ںu7V\Mf4~]f'Z?hL4[pMq 0qw*nNKO'ATx!\`znV'Ni^Q:NFqʨNV }2,]0L kUݱܧ;!#"P|G/H@pEz7YǣSpjnMOfDڸߏp?p€T''5,o挿 ̟ciCD4X B;؍M$U4QJO,x>/q^;|x=t _uUW}4kFDŽX$@Lch'O^wu?³DZ7}f[y , qS>@xV5ry &qn6r#[eGDS .âaUk| )+=a]ns,g8 aB0N/Я ; њ _]_˵A_b BpBc|qW۽_*fÑ72fYtCOaYx fYv}3ggco %pMx|# o} L ϰ`]?O{ TpW(A:N .@]{1qˤd+S83H>.Uڏ]߽J[K(#Yn4`$`q">;7V"uzcpI" bܵP䓕?Wvb  y?B(Oy{B(29}Ypth|͚59WiH޿QsN[L>}B\uOo34~??'eYe@*%M#>FeӬYV{Az.v põOJzFB5n_C-s=[P͙O>hO8 q3i(kEaE~7?fzh8/!_ezCKSNjժGȾ_?sXHG; M`y'ae0r](_6w}ښ8TUSC4 |4s1W9K(Avy҇ Ch 0ѣ;`7z/>K *shKDKf[b-;QÖCwu}_0Dx( hx"k0ȑ#;׭[~<N$l=FBpM:YA; ַF|| ""r 4+6UߎB*4ΝݸF}DƏr!/)P㾵6n477?'|R@xIh=wYeee]vLs22p~ b z7# ϴ_wU5tD :]w}}o }2`֐:פJv_f?+;g೰8Ԁ'"@ i}7{“.mhJÈC-KE!0a/š=qƟa濌L$欟0S9 X8N.駟.V C.ȓf]fx'؃]/$7g]`M^RQdzH ¡(Am}]vٝNmG`kPoo$"dJ0,LjtYNX$9L-[PwH]B1PcOa[!E``^裏ބn(i8qX:y<ͦvp*THAv;'=İȒylj뒒cp%Wdw sTt  eS{/`4=] e FG`Boϸ xd LW_}> n3gΧ@63^ь$o! J l4Ss8Wz&xԴX}eСC/>^zvg=;&gQ3qs&ƭRvD B"%lŊY88')ݽPl|7m۶ǵ<TO`3x(21N31{*m "0$D "2a ;늊.Uąyl?YYYW^y;^.K` |za(щ\|:= K`(@` P)--MyIh=DeHIttc {f$nֳ M2>Z:: II`LO;L38?ۛ 9f3?iOJ'2);S>˳,&q{hS|o<;<6iCI s=*Ҙ<{_9Ozo &}t07{``ͼ>l0&~ܱ)_IENDB`haskell-mode-13.14.2/images/haskell-mode-256x256.png000066400000000000000000001207161253441665600215310ustar00rootroot00000000000000PNG  IHDR\rf AiCCPICC ProfileH wTSϽ7" %z ;HQIP&vDF)VdTG"cE b PQDE݌k 5ޚYg}׺PtX4X\XffGD=HƳ.d,P&s"7C$ E6<~&S2)212 "įl+ɘ&Y4Pޚ%ᣌ\%g|eTI(L0_&l2E9r9hxgIbטifSb1+MxL 0oE%YmhYh~S=zU&ϞAYl/$ZUm@O ޜl^ ' lsk.+7oʿ9V;?#I3eE妧KD d9i,UQ h A1vjpԁzN6p\W p G@ K0ށiABZyCAP8C@&*CP=#t] 4}a ٰ;GDxJ>,_“@FXDBX$!k"EHqaYbVabJ0՘cVL6f3bձX'?v 6-V``[a;p~\2n5׌ &x*sb|! ߏƿ' Zk! $l$T4QOt"y\b)AI&NI$R$)TIj"]&=&!:dGrY@^O$ _%?P(&OJEBN9J@y@yCR nXZOD}J}/G3ɭk{%Oחw_.'_!JQ@SVF=IEbbbb5Q%O@%!BӥyҸM:e0G7ӓ e%e[(R0`3R46i^)*n*|"fLUo՝mO0j&jajj.ϧwϝ_4갺zj=U45nɚ4ǴhZ ZZ^0Tf%9->ݫ=cXgN].[7A\SwBOK/X/_Q>QG[ `Aaac#*Z;8cq>[&IIMST`ϴ kh&45ǢYYF֠9<|y+ =X_,,S-,Y)YXmĚk]c}džjcΦ浭-v};]N"&1=xtv(}'{'IߝY) Σ -rqr.d._xpUەZM׍vm=+KGǔ ^WWbj>:>>>v}/avO8 FV> 2 u/_$\BCv< 5 ]s.,4&yUx~xw-bEDCĻHGKwFGEGME{EEKX,YFZ ={$vrK .3\rϮ_Yq*©L_wד+]eD]cIIIOAu_䩔)3ѩiB%a+]3='/40CiU@ёL(sYfLH$%Y jgGeQn~5f5wugv5k֮\۹Nw]m mHFˍenQQ`hBBQ-[lllfjۗ"^bO%ܒY}WwvwXbY^Ю]WVa[q`id2JjGէ{׿m>PkAma꺿g_DHGGu;776ƱqoC{P38!9 ҝˁ^r۽Ug9];}}_~imp㭎}]/}.{^=}^?z8hc' O*?f`ϳgC/Oϩ+FFGGόzˌㅿ)ѫ~wgbk?Jި9mdwi獵ޫ?cǑOO?w| x&mf2:Y~ pHYsTTyJdiTXtXML:com.adobe.xmp www.inkscape.org Ǧm@IDATx^Gu7>i]z-˶d8bq(@b =)$ %|16˶dޥV+i{}jv{&vv{fΝ;wΙ3gΜIPn@B_l,f7Z ֝d UQf4~S#Mf[u>>//-bGcƸbAb\2pEQC=)\0-3İ٬҅/zM'"ht[1hp;E svO҄!=8)/= u_Q@;Iՙk@x;̆(n^ҰCi[' |֮n8̰﹅1ޫsCN;.X8{ެg{fY;f@xY=3_%M $p>;96 7h^tn&y 4Ӹ! dz%,PMhv=Ͱ 432,pF\r{o3N_ܠ7 {czAxgiwqGU,X7gΜ‚,_FFF,<'0!!AQ8ď\===]]]--- On?x`+b1,/:y/Qޒξgޗ{nq' >r_t[fF&f m F@ayB$yw_tɒ%UUUJJJE&Cv@.nBƳp'?^s΋O>d|/: @qDJę@n?![fFٹD}%,~} LM7TT]vŋ׀u_D/<'1 ߏD'N߷oɧ~v֭-0D. v(g4f H4tgޟ~vQ ]츼gB#&^:GY_}mnnn% {23a wmx)ik - } #> tBί[yZ3gO(B _]$lBΫ3}{_s57ƜBLt7@Pt`޽_|#7k%HۛO",lcJXތ?~ na$ 2μdfX kA ;`>|pݚ5k6,Kazt>SEc bљ=%,P_]‚/a,G yOܓ3dOb=/w̃&» 7`> #|:ULCX$DZiKA@i m.DfܴulؙELh/~AvH{3.־mokܹBZ_ܚX]h{g}B<'ߎH.nM MBF$NFw! ǰ7ҠӮVCLH}H܁Lw7,szs\e@ ^ַO~rMb`I:AvB.Dl" ~3LO(H/~Fr0ؑ>,?/Z^HK7bXMhG"44^|a\im[J~ḫ m?Â7?n#=_׼}{wEEFէ!8"poπW}[u nNK_NpCZk-NoJNNT $ YYi*ח 0;;]e"r9 ׿'_H謀 0h 0tCC# 2]Au0WGWgθ$BaA*WE yYu=FFFd~}">]0 _$Ca'M#4tzϔ 7/!&/'/ 3??^ﯮ8@.P߮;TgW?~ȏ܂ǥaf1u夫\5"!GeƕC!譩y__} oK$g Oh0~ t ciqCeJ؄ŏO?}Hnm0z-{v~;.^hW mbsy[YF<%be URSsҲ<1lg~7Q `ƻ!MB dvbد ֤07& 0~5uNaBq FUw^^s.Yx1}02s@#4/S͝W,,Qee1S7{pw"G0B 켄 '4;jAV/[$P.g @. 7!ӌO knRg4Z[{NK/,/afz5  Tb5WQqw4C_׿կ~(1 M" @ du~W/t*`nf~6$/aƍVWWp;BU? om aA~MBy!vX]Qh"U]/3Lj^Dn!nҗtG>O@W:cZ ?r^4bn@g{B&&PK+ rk/~qd?ߍ="2#v6aIwŠXWVv$lB"/' #NI VgÆ >fE0:ToYQI FFjBuuZr.VbgՂm۶}W5>݄ P @i;,W1$:I؄e"=E.Ap)NjaAuwO<ŕ+W,y"mZv#>Z=L6#D=.u ӧ֖,/Fy# ={8 +,F$NnP 4vXJ"a7Bx'Bw iEȮ׷CT]mrqs|P8T(ͭ,T+WUzZ!7:p׿@E$h^/? ^!bE3"~+ (#??>\HƋj׮-HEf]ZYq몡[D|;nmB oB! oC!q_1İ&ڈ߄󲑟/{{S{yECZ_Y䏨9zm̩ UOnLHBYYZl^%Ã@>?tmi&T^eXlg64n?>o`k đ =uGiIKFllsXfF| GpB% l(//!:~%Ty5Vhen/aB2aB" ?y߇OcnR~.qZKQgh.qDt=0V,1Y~Ni9@>gOJNf%\^'wyKuJ˖!?d' $H/$|@L+" HIE] '=Be˖?3Ҋ78f%NV Ux-U96Ep;z(9R#&G Āt D4*Jm#mgX0|?TϿW v-^pp+Ioh@,n NDxjrJ@kJ&ߋn븫pnD-;Ʊ9 b%/u3_F~A|Bo|_[a`h%wD`nz19n@TV iii6mZ{~`x$#"7I`I|)O?^ @A|D|s~_ 9^8`?뮮 聍V͘fq E:x[` KX3b7_aKF}B7_F=,/Dͺ=lga KҘ 8*}X/'go"Dzu~l{ 귯fl]-@"j6Mµ>U"Pu7Ⱦm"f"]xf-~B}  %@ ϟDÏ{yBu- - 7ݼXx0~a7JkPIlAmZ!L?y d]eH"^Q{mImwnV实t r'L`wاMg#6Ӛ~ƙ~3MTEl!& ~_W` Q|/v!M0Z@F]]6>w.-yj8dεx֌$i[DtAPlM^dx'K_ 5C禇z`3896ޫy9AfXДtDz>S:L ,Xns=wϱ_Eu@DMrVn1l~TJ~  !-?a8? W%788bH~%Gم<:5ZLŦUۆĄ m7߻ZUVHo߾ǰ2KD&"Lg^!D\ӄtDX9Az'HoBA|BM" cwg'w-JHxRp zuYu|AHQ_/\32RqwZ\OۺƩ492@@vg`K+V?=2>,-U(q"&_/N @"=ޝ/!H?OuwM}{SqF{0j߾Xs0I>_j^ߴa_~DBUΛigկ BB|~Ι놡6dY9d’lٲ7nZ!BA8a2!`C^.)_F y/#@auX[ E<()@J\+@ˆ]9$@jߥ>vO}/HOh"pDŋs8Z=9n/aj -A@3 /(;aHOtOiC /7K-_Q֭⪘ U.i?tθ;wW#"{4ilҠU. ' „RI$$BFlg>Bџe؄$2._VݯrԉC3)״aozz:+aL+%\J.kI)ӀK p)635ՎaJ¨VV^nqq.86Es꩘ TxRLݸsk{.f+ilL?yv$B 7ag>˞,3P(ԞmEǍj%8jqYќK,:[\Hg9K0=:D 7 BTzZ&ꞥ21eHKJBڻ:yV-Z4OO<䚬|N56x'?xgת5DEz`agb-K{zzo۶8n/HoØS_|NddeOy}iJFo^=G/vX;jգԧԬ\tHOB7` K\AOOy=bVPЙ. YTgG;\ǟx G;>_&>==R{nܴL]{mc55N<$@B 95Ke 8Hn{s$ѱpnL! # q7Ojo|ŻhD.,VkpR(cq֑IzБM hA_|)}9~u|6pt! AKK+i:CeU8[IJ%,o:"O!Ǿ>wHO&n/ž _Nw D#!״f%M?_H~7ob_׫^ڏ}}̉" Q0H=0Ng.`gjVJBL(D@(~}ؙ ]K1HK=殹x;v3KJ9I#T?q؁ϕp`#"B^32tujjI1ds XeGJ"o? C7޴Suo6^`(.@:AG/\n{֞p? |@Mw.,坉H$U#I(bA^pA$ =`QO9X" K\^n64#'`6e\K\^Wf +BNo^DpmBT#? HRq_E>} 55ĉs- 5/[0CůB* +WR>p# 1~ͱo^ޖ}8HK\a#q BH'$!%8'~Dy<9fc!B67__G2 ɋ@~-MR煡WLL)F $GZ7S3/MQU8@\@z#c0fV<;YWmm]+8µ(/~]mHJw>`f_%^ 1~ĭq8ONO)DRX (%4)+pfe}I)*a"ǼV3&8BP}G ZoN,+A%Q z̄"gԹF(T PپPT^qO/d{-.& 3tsf*P*-D~Ma[g۱/Ov`7H %LlfM?ݝW0/qY9P~CRJ<#oi[Ry5Lter̓~DlHDt6vkGrDz~k@ Mtb[.$FY8R 5`b6)^\ӈ `%W$&`~iٓo =s_ 30(p=24ap 5LI4v`$9!^0p[0 Ü9$ Eئ 7tvts3 Ewic`JAɰHkInNG vXdqC\~6'e?K* 8=h`^|F.xs%^8K~IoT@f]?st \"ƛW'活Ի޽׋ܑ' _ZP@e|F ~*!aPee8uE;H2` ꑡ Cm= $=}!89DT$H(أp1`9 hcZA; ,]]q@-$捰.c7nXrsC@!߮ǰtOz>aq? {4 6g̙sPz[tfcY1#?iU|_/~ a& br#QD1Q58n e Xvcr ȥe>LUFf c)$/OnZX:C?W4͈%o_*pg; xD~K"U!{T  37Vdi .mqaC:H>y9xݪ4#܈_?/af&黎%\A ĜAy8$ qGEԞidL(Г^Sr\- s1miYZfڹ,,[5Uk\n/_n8(q?SN,s|HgX*E\>UrsH׈3p=Y%M WRiOnLo;^v^eڰaw aaqx?d:Q7IDZ*^*2`'旊̑hp+1Qm ^0Yfž>ξwC&1qKt3B0R))k׮%s?4a8BWaP7pޙ3^;k=t;VR3m,CSp>][ `7 j"0Q4Ǔay+;9g'\W֭uaV)bS,/2^((xgCf8OKxM(p|'O?v˾sXO>M'X.lp*Tss+X1g3pFyE:z|; G!gOKԑ)Gc-x_L a[tvb.O=n]X2aiG H)# R)zzdZC$g%?2N;/'H/O"Ͱsvʕ+s KCumWP'xx*Pzwe*#"b؄ܡ%i &'SYDЌTة$XFHF"OAA>R݉sf&:,h.^R9bO< *d3_ B[ay A`T8S%%l*AJƒs|jS_Ҭ:%}M|r*@ee>F!.XOCϽ/"}.T(c&^^8J~f"sOLm'KȨO8~ܳG}^5ߕS_?x#G'*4Պ@+r-}9S,KONn ũ#Ṕ"PLY)`S2ʶϯ[ߍTݻΨV^O9E#4tjj/bJعz^U+V%"f@)e×J檔PTQO*I p*PR5x{Ye[ĪMcWPr900?_Ok3l3MYD|[ne :9E)pݹ6PdmW{pM<7Kbϰx=Ԯc%<})yCcj\T S;dqU @*  ö*yϳB9q <㠕6`f@0i޼ykm=_j. a z@}D`n)nJoqyofc$P N<{l\X٭ڽ3ޱ#vb%ضy#k]/ΏS&G;K7\i!A@M2Iv[G?¼Oflon8EI&Q7n4߁^A@&%Bܷ^&\d?3",F`Nv9a#zNt$=d)`}骹CbMHPaU s|)- {Y{\lN1Nj1BIfӳԒ%e!_ ˁMMMoKH̖h3ISwuDfqҼovan?յ#3*sN -Vo9U- BG0VlCM;? fEgT`  tjc$̒vJaTi6 ѼT{VąP8E rOdX~f$aj`Vt-=@#Bf0&%baF*/pY}_+DV"G6bp0Ah$z^ ss3T<ձWGqwwcG+6nZFUW7fǾO .xq~"-q'6r_Cp%`f" 0???IQϷk-8uS2GS5Hż5/v6hRCxPzuϽ+4i(@g'VIȪWU kaF+ul^p;CaxI-W9{ l[ghbn%= fj0hrKAȱYD8iӵB 0̙3ux N(~x'pEB 6,@g g{ĊN&0wki PiS=@ i`}UA@ mF-Fpg[1Ӽx8)?@㺨WD]ys3A "+ uW;`A23hݐ FΝL_'@>L|q"//@qn8(q[AiIǰ'Ep0A ^tX~lGF@R¶9w@ZRzD{[ {׿܋4uzxSAL:Tn>vj1$z*6C\eTm>|Cy (OhMepRˍzU $ aTRYuBpvS58@EXaU A$ K< #r2I?-=zm[gϪ\KWdF25A(ё=X0AKJs,ӝNvI|]/!1'`*,,Uz׿zF,XR=p|mJy@OWhǟFc< ҂P%ݝX`4-SqѦ;* B]ΪLsc} xuj+&'OLA8FMIN8[B'tVQ Eg;RGPH=8bZrXC>0EsׄDl^dx1vNB M@p-PֆphF',’wvC={(RV/_Z=odBqB婇T3{ad64lA; = Ta*Ђ sۋ``Sy8TVO2ҡތ{FT؀JnCRv=,p.4ׅ~ 4N.8F\Ao/ *;70~#plÆ ^OmYLKi1bgC §c..Qs*w!U,x9}$ UWWk8@zzս~6ٯ Lt~;y twj*PnĴP&c9Xr% @(~&QC@.`j1H&<07>%rp"tc5iC ȟKatnP [jU*$ ђ!]>?cZOKK`Q86M[4wH\xQHo] l35`6zW[Hsg\K9͚tB~Nx[FN%\Va/39W 3SgiJ_@<g@IDATՄۇ0P׬+@ǟTukS?݊:cҙ׍ ,S]#,K5"N:t(~=?-Է"@$چrʘ .D¾^>t '>#;.-_QOf=pLbe]nuGLCD0G~<}EC̃̂n~d)ppAKTF(aU Ҫ v40Ū7nX, 4*V T8<2(RčP9яkM\ #>$C HB^d_NAJ"nN%9*^V%̈6< ݛW9yXv af;gOW)܀{LU ˆ*Gi;:Ց#P~)BbTVd*PՍlĜSt½ .'JEcqM> |vq3 \FJG y4Y9.DZk$WH#D{]5A:݂fֈ E*@3mXM!=#H(~!LƆU=9 SCY\=Ҝ^5I>'$qzA#<Cd4s6BAz%]t҂@߀YpU=c2GW`BaUM7'1~c*Ga*`:yj=-)!Od@6{x@YH C8! 8փ!- `܇u8Jgw>pza4|@JA]`K6̼l !0iA*:wܵ}S8RQ\{5L+Aea(Bd^ׂ⣑OuÞ cׂq1%!]/?K|HR6i<:5Z O܁-S Hrdjo\MN%gUj D+Ř ӧ hԶO*ӆ {ƆTp*p lh"1JzuU*^r 5t7<\ʎi&|E-c|t,0 [q|IfCj9~ݷ'pUU KNC6Ly@aqt\]HوQ:`*Uh trWSbH#܈s5;vrQi&$aԛ0ys(3/̃؛`1='1N<֫:iZ4HJLoY&ԛ{ td7+315:rX5ZO2w9Ms&`$U&~<F8%@hmo#kwbb,7lܴ;<؉LY:;| CX Ee)AoFL{~81OLc<%0L@˃<56ɰջ(N(ӫw^pbcRӒS`PjҫE1S6x<6`ݽ8qJ;'&<Lx0s]\#1`|p <Р?Wݘ]3k mw-+Ф.rjNr*Lx%~oWꀢR_'J#iѻys/ojgƏg#:wC>?rUy[= kzo 8,{@=b[r C̹@C`Y0q.P/J.,D9Ŀ8G<ãxcmٲGVh`nJ'`πXzt$^d9ҏ+2c'&ELg&%W bF!Y$<$vgj` v%1:K fG,U\X}ڶ BV8 H߇zfW-MiFzp\ Dh [;׈sZF qcy#|IvP{9z*`qT) ۲9&׵iSd~~K0IdYIc֟8](΢h"OVkɏ9o>7CAt# [5⌁|ԫӁ=trgŅ8׈sֻu y!2vg<ti'XvG0{r2G{gךLTǶ&ԁ,a Cs;yD/Tijt uď*-ST:8-wO"87$q-QX (eÆQOk@+g豾Q}_~l6E=tάy#FRʩsVѳ<_R_ č[k\ hӂ L_NG̛U2+$T nďs0QD>$W x_ҌJOv339sR^mYJ.;w`[s&LY}$~+B̬Ȃ :;8" gS[8@B\nu[ 8@L9COTdDt 5M< q_d`mEGx um券pE}WpU^^ԑ 1AqBz`8%%"nczpoCX !Y wgX6g- B6LUzQ}@K<~c A@=<ӕ klP:~Om>D&˂}ِ#}PTηRqO.a2-w {S5%%}8őSu18XtԿb^Z;p*P]]Ǫ@G{#XĊ_qM&iv7z Vi{#O"~JzAO_X`BEMXFowꚵHL| T*Xwd*@@@(Y6qqnH'ُntfZ k Y8jNG?{3RS1C̄|qDV5kP蹤gmfE}xYJԟ X }\ F.yAu\s 1vL8e9hQA#j NWGXnqËQp08fK,:ܹs$Gx"ztw Y9'%6hucy2<%$:ɠ~a)DIS1H}ǀTIF̄S$uuhuI9r?eԖh*Jr$޶ MP^ {5Ğh]l:: 6ߐC`_qÃ$<(`0`fQ9ڐ0.ٳCCC8$*$Cヤa+m'8枘]gjk'fތ%>"'[;#89Śxi׬-ЬGEQ P'@P20Havkz/2|5G?|SOC9;t?8̼rػ<45Fy^'qtdX8q _Ҏ`@nq~oO+`JS6w4k+LGN!*΁8LjkH˗6q{Jq#vK*@___$9~|sWuLWWԾ}5~0W ^벧NH[쏀YH1FZtHSZ藊c23Vx5Y$;lFFڼ unPGr}k] q‹#אvϙ ,4 Ihgd/pF \Ce؀{!tlƳjc8yv$AiǛ%]< K飗8шs:?YZy4럣RT$,: ՜TSs /X8G1G 7#-^8MINȄ-8F!89L|L]5Hùh򀑡T|VAbfmz3eˊp$N}JZ~(Ĉo>CEgf]=]56v9+HO?yA^{vbA,TIIVZvq‹ PP2v?Z;\X΁9&pZhP}/7"#s*?yk0%= ѰK]J Z_:ǑG3YoJ bNg6YsM>;_X; ',tv)8V{v#Ts ]|l|/ wa s(o39}bD(G"ӹąj XjB)H )Rݻ/ D98zD ?B{U󾷯U8Un.p{(hp:FY#m-?vQ] i R.{.]%ҩ[hOXւ?Ԣ>6FwROv q*P"~x~[q-q ߎM `o\~Ca^=\*3)jbM!QDAR>Q/F /L*+m]-]QG ںix?7AomykPңYkbis/J?fR@7X{g F*|T18}+TcHKYHMH$ؙKxJIkkkP J '*a-L3'Nr@,~ vޡ]7O+hBAx;f2~`F}BQ[VeSkg8IwC⟋ڀL;Vvq!#s3ki=ZY~w}q#nǐ6PMe@]3o 98qbKJ`]OJB)86WTo=Oi/u45X>!(K~HQa}9wS̞CFEŐgjOTǎ^}.> 1e"GqY~f9^/F :}8@\Ed$+ϰc8Brr1V\q7FKbݹ6ڢDÄ@V0'O8Qz*J%e,ju4sr1v>!V#3γ(&KNLLĺ\Lzz_19&'F,lJ?8: y3ܹrIFzI Q594 nM bSO=K/ԀDh"Q0/AzBq84& 'OVp2=P Ipx]`MXQH4 fa7'Tt\ځKKKQ6T+Pf!P|_XHy`{W۶6,GEj~urXd,P\KVbr.ַGGeUچ,oIݧ 1#%{YTV.jkk/v80]/ovE :/Dy%'oə҃9,vbNISLRT',B]} ^ToهѸ_͟_ިT; G5.YZ*+gc`$ 7{ȩ>t6͘cږ_"r JW儔d[[{Y<_k4ܯ Ұ6(#|\ԫyp;4-U}o[e >?CkM"=^.f fdc`C(:wܾ).P588"!9k9$PRIjj~Rvu׷Q㷩MǴkNQG&''"}{ g6=zQ՞m2C"FP_r/^Q2+9!~9r^1@1wt|Yg]]ll\8gepE(}{3 B=?~CpwĹ+PXlM] j8m$ 9KT|ӪsHk֟hhֿXU/߽ 39Zܕw==Z\ yb$ϥc*Pڀ'4GC_FR+BV'|?|M0a0 7' tyO WrCCC?|' k"ԑ߹&&-X-5w.M5ܞt*,K ju x0!Lp&D:LoTgi:tb:D -9Þ _nX@χ{P/MqiS"LDTGOSNQlo*/"S~cc#7֟A Z;!ud)<,~)P]x *L 뭐ݺc>Ω>C a- ' :o߿#]|-{"EYYn1(Aś6Ui ozz` xjD_^|cjkWug0;A"X!HAt$hQx[=|t(@?%Q'=3ہCN<9=\ůrU `wU S"Zxr'Ǽ꫏=GqnM DA3 fB"=m3m!Evl?l,,ގ U;l0 ~#Ũ&_13 &W(Cn}嶅0UyG@K%wufɓU#ˮNp cia*gэ~-X`sQۯ/GQ^#tl~VDwD{8՝CI)V \2%*ȁw>x}kݳg9~P"P (@5xB r-/\o8GH `xRPBtao|}>VQ_%rti9>e8yI+bK%Rc" ac_q.-1@6="Dz=b/ôdFZϗ;i;vadj"A1=W>{+c`=tDzbG2N.!D|O@8|.3e!tXy ۷͛7$^;Wq90fJAwUN$7yiss}I=w_a]>佴x$+O^. h O4yFC >c>sqɵhrHZ _|}C|?鷀ӀZzsj~2og@H 0Kůeȩw`5ePtcoD/5'Ȕ0s=89gM/7d@' LB&?G?M6uxY */>w S֥WS|$N #ȄZj?Ŀ~3Gn\%bXg 9 ĺ!HOªOG{!`j$DN5=Є23#sc,F[q(' B)B8h_ZyTpz`>#1=/^ /0g'm:;҄sڮ{[KI mv})3~G=s,f`ā3TЭBmܠYYňC){(% qk iCsG9܈K)e TWիb)'>_t*ڣ[j㍘B@JBǙs} ;n=m4\V@>,~Br&VLC.4Ҏgtq> B'qcuy|XbB*aXz뭣RoePgj֣ SiUt\檪*T7Av@X wطWWL"`fd@YJ%>3/.\W+O F5tS kL@  V& $F35!zgg1cXF r2T1KJ󰝸Tͯ.q(H}: \D};$u Wa iZ^%& KE"չ!P> pHE`0 g%`V׺nff䄀%8їçĘ/{ˤ1AMHohPfdj覙>(9gӧvAZvUu_vMᲲ"MV7ѿ4zl>8ŏdpQ{ 2 :*Ass5v8@'зoiplpD|P`{eYߨ ~UU/fu ?YBZ[h\r _95د%#G{jp[ P#DN]dēZ/ EJ(8nv…00πpSkD1+cl}0\0uAM85-6߿#I؇Ts,O`[b%^xq871 qm3u-eg+(9ss> Ⱥ~(J5 j<tTPB#9!u Ӆv#T #2pu^_즑z슭]һ}2 {55i@]Ѓi[V9` G۽ʂ`ݺXN`3ѮU3+=\llqܚ5k^#FX KT5yRt)8>1f)c ˫> Ι3登l4N# v /w$@8e>OY,Et'&Ө't )WзOq7 |V{nu G`t^ +zke.\v+{=<{bp <|cTZ&{rw}.i^&s/ed(dD93=fdg3V)=+Ǵ(;k_W_OBN Y#o1oơ{ j6{Chz|X{[uUU5g}'|0=`<Ǫm mUWL fk?vȃ:H3QNg/Kצ%o=鯞@﫬<zw{!X9(Ylnǃ0݃}Ќl]ݙslb^e\wvqȷ::nޱc'NBi)>g3/qO~nӓv&,-@{||bŊ?<[4\#?4Q7 @._[PIY9ʈT[QV2҃gtr&T/9)C1"s[ dzގSa?6W陥X[]OKh`=?7.usi xh] q ΋P’Rxt ±{Ͽo1C={p(Xak~fmmp [q\W5pg{_x.&puԣ@"TǕw PqAD˃=g.O+lz^z Ü緆 9Y|^W6U>ңQ p. ,ӭ;HC?<' \g44֭k|:A-`}7sF 4kGh40D2qա,>|sq[l{76k/JRݍo!⼿Z!Q̫y*F $gXDzLۘUww{l)L W\z̜;SAjH^pEw|N *SQ*чp^7b.mN2WJp|] [B89Pp`Pǎ:4҄| XSg@?Q Cۙ9=7nܥ!8 K+u_~m4.qO1 3 Er˧~X  e,$׸QH '^{͛7}ĉ7~7RM需K{8Y!pz2 a3̗|_CLp$+_w?R#@'ә5R(xv™g=Tn¥ecq􉼘7|I&̈́?ߨJ=]gijÛlؒixc`ư۞z޽`ȳ.8_Z>l'p R!ΩT 29Ԥp0D9T>$bA.>U _/wY씻?d/RFjZ%igی몫#=uQ|a?<q KSްdE4v]8@xpqm4!]||:n7ծ.8ڇ nߎ'u>|'y#6һP&եiJWq|J}~@F@@'ES:y/YFZ(` IlX2kڣkOWdy{w9t}QH^~8|ױ2ve{ /|;l~}t 5̏MNMOLԂ]Eԡ{jʔ)0kt^j8DMv+ǦN7ܫ}@Ы?Ao{Y^&@xTc@dy׮|(a' -\TUD935'Ȯ6^/( nL+Ua zϜ>}S>ū Ћ5z[0%P^o,O*))9߽x8;on owpGZM6CqغunG)=ei6@ ~~KFZŹk052SU\, W0iЬ&  "}g?Ê=}oVf# }^#pA\C +a1G^^a(ןs9***❟RbJ|b<" U.rp郃+ϝ;wW_#Y.UΚ=z*=zt?}wɹګbBИN~wp #n}_F ooU:"]c0 r Qr튋/҅yHqǗaOjMpkԉ<@f pjo259U!`_O~tO|bd53Q«@;)>8Fp{,Z7SDhY{cu~dԩClq'h=d6oIiyP<=}L{_9j#{76sahhp?F9w/LOtIVT|?6E2Fi[9_aRɔNaX\rɐ0: ށ ޟ}gӃig> . bYg7_[~߂݂_[[^MiTa\ܧ~6o޼wߝׁ9+ /YLۤ[󌳂*sVv-+_Z-'#IDAT}t>erK>4`\d +W ;}mfxo-^>ضmW(Zi<#in(۬Z|u}_4ug} ~5|7(UiƗ)\3wXbN:[*}Jc7Vb嬒*5u!p`,|շTY5:S'MeXVfyœZa\ p38cLΝs2\=~ kI?gWViqnKo1Μ9L۷ok_=}'?a=E=JMmXy ng1˖xѢEX6ֹ;k׮mBu&LlNbɢL?Kc ns fzUif.SO=w~L}j xkTw o.sQ@1%&u bq |[>ۭ:ĵ4 p'O9,.?W\qŽ~OzRy Yj o).? 7;77D E"|'УW^ה*'ׂ[Mjܚd!?K]˧>?lX_tgLW5 ?.I>O#`A/ٓ۸F \+藭0v0 s0v0y..a|w7/ccǞ?8óf`7Z=qNnz/-\F'OEy?)N-%3@O|:J>04;M/_aR료o 7</v/XF9Mzsg.B[fr]| pjyAW Uܼ^z+M I@خxŀuu!=NW|EtGJ_>,\ǎKqR,= AC$k> lL^ׂltsE_Š+7\y)AYϮyV[[G_8T&zǷTA@O|QMt<éb-nYEɢˊO-[6N;6Ӹ<ν<{VpWbjpoGziA1^8_0:@IeHzQCEQ]>)(@5EQeغ<}x} 1ZTVVZ2jԨ+qP >W qO!n'mHRJ";\~ǎI8O!B8ǣSO GWX#? 2@/~ xQ`MU^r(l)yLFqqED9]tm(pގO'x:.y4 Ȼ(ؕ¢QJ2`.߼qg*Fqwl~tKx5dI@ʏ)=wэN . ~~]w{=7 [/[ʶe=S{ң7.j~pOxī 08.8q y0/mSs"Wc_ֽs0 ? C^j9Y8T7nܕQ^>>?n+|TisH>ZeVEym;5k{Dވ#‑2߫W;3f vq'n>1O={xp-b@?яꪫ^o/0g?Aٶl<);._`5E0(o{' 0_8~:LA6elP 羱<`8@nl{ݰ;`4)ir9\߯?bْ' 1U8:wqSs @x (`Ȣ9,F~} x`yoCΫ+++lA\5k]`8f)1>oZ qA3p|!9o~x;(+(2"|FwX}{~ % k/pɝ\fKh[lY2>yLɂ{\sͥS`:SؘZ|-X|!wq1qߙ" z>qqN.E'|^L{=YzD^jի8o~.%LTT'OGIbR_wI}a22=SI8LwIxdM[q`EuSAmG9@;F.;y@ ~qg`AyyOw&OYT4a k׾^so,Dil&+&/Ћ FF@WƵS#*_aK2R pE o@:sgbq歐y.O=]Ap_jjՉg}(?Y/- :w8n:1Bw9ѽ;+]?՜ nK;0 r">0Ӷ'ʦ6L^al, 2Lghg̘1n_/>;&H ޽{ҥK8k֬xHA 7;ej’*pfd}Hf)y߳Q&# _Ɖghw饗馛3ܲxR2>qyj=:|Ň~9sPNkP[%rzQb'iю{R\<tQƓWX… O.9s*ܗxЖ>L¤ C(oq<ukvٰxRyB<9}j8?o.a'bx Fa'>fwz['"{o~ӟt5[%mZVa7щ|TVؐ[Gɢ(e<8K qDY^N4i4ѣG9fc"[\~o7Vc[RU"k7_J] oN)i( *Z OuEQy $SO;2b^8C 6a ^Хc̮j9ҴKqj_& (?.y+,>E#ϴiZ|-2>/O٘)VF>*˔",2>80U`v70Cʋa!N q+:kS mBwI{SX`&ċ2E)KYēQ(Uڢo+OEQq-ĕ1ߌ0tkz9t ϡ9SQ G㕂9μ)^ po߆wꚚm[lيs._|ŋKt `!AZjy+cz]#>e}/rE4*FՖ][xR JoEF,IFJ0to:mKt:rQ˳@6(2:;ɢ`eI3/e]|L|2֩Vfy56 7N7VS&y)($ާ~ G1|pذxL,KO8)c>r4ܦis|ʣx,2Yu4). kA#R3Ws ۴Qdf':*P|ɢͰtmX|&ge)RgNׇCbe3Ѩ8+*L CH ka͗۰ƦP0VKX4n*q֥4 o4`'lL dҟgQdxFY3L|PQ@(>,8^ڸϠ "CITJtpcHJL܆g}lh8Ih dk Y.Oh ^ކ-E(뢀2sclAż,I28]/,>,]8pQ84G:y8ɠF!y@ dw()Nir4.(t#i`uqu-]x)5n: lZ'ȵQ$45v]\*?\5Ih51$<4ߧ׫ kCW=Z` ZIvY4\Y~\RsSKO-dMTyIENDB`haskell-mode-13.14.2/images/haskell-mode-32x32.png000066400000000000000000000122701253441665600213440ustar00rootroot00000000000000PNG  IHDR szz AiCCPICC ProfileH wTSϽ7" %z ;HQIP&vDF)VdTG"cE b PQDE݌k 5ޚYg}׺PtX4X\XffGD=HƳ.d,P&s"7C$ E6<~&S2)212 "įl+ɘ&Y4Pޚ%ᣌ\%g|eTI(L0_&l2E9r9hxgIbטifSb1+MxL 0oE%YmhYh~S=zU&ϞAYl/$ZUm@O ޜl^ ' lsk.+7oʿ9V;?#I3eE妧KD d9i,UQ h A1vjpԁzN6p\W p G@ K0ށiABZyCAP8C@&*CP=#t] 4}a ٰ;GDxJ>,_“@FXDBX$!k"EHqaYbVabJ0՘cVL6f3bձX'?v 6-V``[a;p~\2n5׌ &x*sb|! ߏƿ' Zk! $l$T4QOt"y\b)AI&NI$R$)TIj"]&=&!:dGrY@^O$ _%?P(&OJEBN9J@y@yCR nXZOD}J}/G3ɭk{%Oחw_.'_!JQ@SVF=IEbbbb5Q%O@%!BӥyҸM:e0G7ӓ e%e[(R0`3R46i^)*n*|"fLUo՝mO0j&jajj.ϧwϝ_4갺zj=U45nɚ4ǴhZ ZZ^0Tf%9->ݫ=cXgN].[7A\SwBOK/X/_Q>QG[ `Aaac#*Z;8cq>[&IIMST`ϴ kh&45ǢYYF֠9<|y+ =X_,,S-,Y)YXmĚk]c}džjcΦ浭-v};]N"&1=xtv(}'{'IߝY) Σ -rqr.d._xpUەZM׍vm=+KGǔ ^WWbj>:>>>v}/avO8 FV> 2 u/_$\BCv< 5 ]s.,4&yUx~xw-bEDCĻHGKwFGEGME{EEKX,YFZ ={$vrK .3\rϮ_Yq*©L_wד+]eD]cIIIOAu_䩔)3ѩiB%a+]3='/40CiU@ёL(sYfLH$%Y jgGeQn~5f5wugv5k֮\۹Nw]m mHFˍenQQ`hBBQ-[lllfjۗ"^bO%ܒY}WwvwXbY^Ю]WVa[q`id2JjGէ{׿m>PkAma꺿g_DHGGu;776ƱqoC{P38!9 ҝˁ^r۽Ug9];}}_~imp㭎}]/}.{^=}^?z8hc' O*?f`ϳgC/Oϩ+FFGGόzˌㅿ)ѫ~wgbk?Jި9mdwi獵ޫ?cǑOO?w| x&mf2:Y~ pHYsTTyJdiTXtXML:com.adobe.xmp www.inkscape.org ǦmIDATX Wklff_cm)mZmF)mRCp+TڿAԢHZ%hШUE!!ƀ16(Əůއ13sf=IJgwι|svC,Oy^+n6:::FEc#9孭;Bi?Ǎm®U@BQ%& (-c]Eaf_}ͷ@hnn.'HED|1B(I =\6v6h`~JM9'~k(B )9% r*++=,J]Ҳ5زŃb 9V0jҼ\E`.ܵab `sb(3X|2sHKH.,2fkKZ-ꊉDNZ &X(;ip:Ul %%.|1EϽi%B4T4tH[U]\W ˔YS}p8Ӱd)X`q0[Oa~rIS>9\RA C*@}xyr+ xak)Q6dJD"++8;.܏fRS0E_|!V\:gҹƉN^&HL&:Ch7W`ݺlr4#(wùhCMn({>ΆS #GZZ?@m?s ĉRl[S5VHDGd#Dn+q%,"In=ߒ^khZ0_RINj;O1YFq 56-CdwGAu 0Tը#ɜ()4Ix?zs~̌ŏ.^PRjS+*巰ȉl iCw e@6۰[L4lH'(/DbQb$t|#N-~snKwwVSW[W.deskF͊ D/TQ~[+37 Pcr|KcrO1^Hfowú[1YpXkVYYq8NV A`]=yϬˡ _oc%'r_2ϧ~IENDB`haskell-mode-13.14.2/images/haskell-mode-512x512.png000066400000000000000000001775341253441665600215310ustar00rootroot00000000000000PNG  IHDRxsBIT|d pHYsBBntEXtSoftwarewww.inkscape.org< IDATxy|יŀDb q&6I83 f|IH qf2`Ovl`;kB U-ujtI9u]t;S( EQTA P"W!da"CO"!@b5@ }?H( CA}uHMA"8`izt$l}/" A kl2Vf{X~"0!0z.>㆑kZz>DD 6 m-A@g }svQ`b2"  D ][o\v|AJ7>"%Eo~M*9 Ϫ>f&!r"9EV?JT1z`}hHnB֓ѷ5 FمUFT^VA@!!l|1':7š(HU1@ d 6tuLT+a*Co(HE1@i d,2T̴cS5uLq?"7`B!L~z U}RmsH3淲ͪ>fFLDF} Ѻ>jZKƊ$9FԌ6Z7GM]@nʄ4AvL~;QlJmz{+=ؙܜ 6C6,6v}FL?+JmjJh*cVRZֱM`D,%M}Fj(H3`H[-=ؙܰ B0ڷ)C+9 k3!963q,BJXh5b7c Fյlr_*F㩖Ͷw&7pB @0Aßh?]t)+ `d5rD63e=u6=;9D AïtjCocJmF+a&~.WUǬv KHn@ЅEߎѾ13emF!yݛՖ\SWjSkڑ : J W=@oY&R?7;Gvt3eRZЎOP,6~3TGrtsV+kSjn`T e7Jf>#d @ *.T cJmza4&m˵e~DZYO]}hGr'A@~VKhbq˵aS6#{䲞VЎOÞ,3ZR1V³jK.Օڬ Fz-W1S+kH aJ ұTGVo+^9+)Q:nXJu!0 1`S5zGvz#Ǭ z'~޺RfFVK$hS+յ;c0 `%?^c)C1clee-..抋B-((p8Ntr `0C~|ax<ι>+ͷ{zz;RMee~reR~eV{b'b D at63_1~x=7n\.*+++++...+,,,+(((w\ep,[y zCPo =>^~ܹs=Zٳgqnяo2z ޿zZoV-յ;Xv6k6fSFc0qĂ{=cƌG1bȊ‘9L(|Jwwk׮_pÇ_{ӧO]SǗS1fB&RR,D/D))V{ͼڹ)ozoP__XYY9. |BWW׹Gy饗Zyh0OաMn,WWjډ:?/; }8o8Pe={\]mh'b4"3fF߿yꩧ&.\p㧏1bg`0xڵkϞ={w=f͚'~DB1hruyqtl1F |/mo,۪o}[3ϟ?{ԨQ+++2 !kD".]:s=N1(٫JmiQ0WjK7Y*>ϸ}yӦMkr73 S8# Hѱرc/®wȧSR[6RNĐ$D 6FF _n瞛`c+..+so}[ sh*ڔJm19!,kr=nb 뮻*VZu۴if@"9Hǎ7|ƌcFtC[Vkډ!M~#?l1r^geO?Yf-MQ-Y)( 8;λ~/zTzeR[bbXr"rOnSJ^-U+555<쳷͞={QMMdzA(W^ݷknn1c.1meĸd=Dd1˵Ym֩3g^z9s4MO0 |GG{xg?tƍѺb@O.Օ;#aoD5FFju֭[7kҥK4\!twnݺ'8eCf͈ɄhZY-14Y Y ~-f1Fzɒ%=O>EEE r`^Ç_m۶uASJhAMԖ؁,"C~=#Tnr]dҺ>!_|o۶mUT<^֖؁,bԯffk-_fժU:u' ~_MBثrP r^MO}DdDd:ݣ~#}6cw|L}}B2u (_w #@@ :jed"2LU~#}=?˲/x%KWUU|뇶m۶GyY/A*!hjee"2M.3~v~?a?zh׆ ̟?9I#^Ν;7=c.\>` P{@@h~k֬Yv7>p85>aO(# #``"|A1i/@>MS Mf=Ma(0,K؜e'cj z=ǧzjcKvzR^6xC@+Y2/_ܽz766.iک A@}e?<0AiB4 8PRZJJ PRBI EE.дW#Be3&qmmh܍n@` PQQu@3D"#G/}7V9OB96?nԦ^gΜYaÆfΜ˲EN\ҋmݸ֍ugP]] W ,dlyϡC^z^>H؛Jmj2} SVCg= A6asl_motįX.//glٲlpW9 O2q/kQ.E]$Rt~ pΝ;_6P ( [BD6`OeM7nlz/..(ڵ~GG\p<#F@_MxZ_~+VhPCw 1:răXYbC߈?W17wMAsg`S"`Q;|CPUQ}{򓟴BY0 H%$@2x`$ߐ՛J7nܸbwԩ+h9d#4NpcҤZTUdtL#"ĉWWX1(% b u=t֓?b, Hs_MOJ"@Wݲe} ,x2J| Nӧ˛!"LXkQX3Rp￿xxj J2{\= 1^)C@d o_k/۶nݺYOdƵg<sp\n&PW_Ij1v܈U>h匾@a(8%0$7ku__cc2ז˗{pT;Οp8S"d!`8i$s-Pliiyi\X@S@ h Ћ'D ~z@*q~%?^Zt}t8מ5tw{qz>BQTĉ0E>݄B-[}衇v@[FjZAb CAl6zҴ> ej֭[d]]ݭםa9Ӂӧy?ӧCG`⤑03,|O<7o|Jb*ujmA3ȀOo'cYٶm .˲Y| h=//]N%MSPIj1f숬!w}K,yEUBLX@n\Vk&  @i+RI.ݱcgΝX6?#x2Ha3f4`A Bx-Z@ ^A% hQ'$M"4H~5 ԧ>~矮q#q%=r@8ӧC rqqz8*Xy_w^y(S"*dM3mڴx)ry@ #/6,/!q8XLV3Fgm`8f@[:AP,WO,W<@Yl+}tg|wF˙L 4NpiD:2}*3_uƍmП`GH2e}rY>x`a- f1Z@u˺c^x?3,f!<k̊/]'ZLYmzah 9POd˹ŋWbFNݻZz q8̝׈&eT}?۷o#r#~°Yjя򕯌Œ_O7A 5nw>TUg<|>UV}g?~%1@D@V rR_BÛqWp8{Kd^! Pi7œ[ƃ㘌G8[~7|Ƀgۓ`i~?֮`6o|}iX`nx8|`N@9SQWAoٲߖ-[~5! '&\&qX0z s̹Qq`yw BQf<fAq׮]hjj~33Hy/rs{Fcc=z|v} ۺ3u ! ,Ĵ. ڜ9s~~oQd!]__ܳg#G~\[K[[vl??S  8hTWf?[ikk B.$D#9n'N,7bĈ9:DQľp@+qY EQix y#wySCD'3Ƞ7)oW_t_\؅o#9a'aTCfB';ݰN "@&&) [1O3K.oq.Aľgq@kߚ@ XNHg?[vbk3Ed!SLY.5桱;`A_Л3v2#G \%xAcr |c2|koڡO"ŀ(C@'1J.9/./}G?Z6ppu8qyES0*:~DZ 9$G8FX׊+q~$k׮w:i =[pЅt-@3f-sW\N '@,B}@ 4fF n^ל IDAT 1!@ /|qp5LYnԘ'3/ qeGҥK߯Ow̿ۋ78'η%Y@Q w=Ei}_wӟ Fg 24 yFotԯWlݺu]v/x?0q8ݒqҥK"h&`dv2"O.O.p -oM<oG! aYwu#қ{ʸł$P@W+6i~&NX^+xݏ N )ܶp &NMvuuijjztTN$a`oEƿ%1z֤{m#/yt%@!O׮];k֬JwNdrr*QؑW[oȾ;~wTݻZp`k:ߒ@ 3oN:_%5K M-`{R i⸿^6ל۟9s766cM!"NjO[gҤXprZ hiiym„ @#Л8LQ ە*\@ssiy^[o!Ɵ@ ԩv𼐶llls:pjݏZ}mS NԒ=z=r3Л7os޼y_"y\hL[m9o޼/n޼N{XՌZm!'P r*\_ث&?o4͙nxABSQYMi[5P=/g`#9)C<ؘCF5gS&Wk׮9qiYiLJ7^;Yݏ@ XDq ws ~poʕ_~vjvPK9bXM1uГ/^\?? L]A^ö7~z\.K.{k]4fՒ,7^&]zrI~Z@y̘1b6Hۥ.ea@ ewKf~TeZޯجY@7 0FTP)6q$F5˲|lի}0^KUTTLeYV+PuOכ(WV{. z+#޽{Wf#x۟@ }܌cXgp@oCЉQ hhB g9\ߏ-Wqyɢ4k (7q@@ȫP@V \Jn5|yҥ#^~ N ۇ~ oD((*r] re('Oa o>I1s ?mݺ P)C<ؘEF7׿Z!.^z+ǩcv AA!"EU%9uuBtEE>Վ={Zu~zB~itHߧ@CCʀ4l8@)!0PzI_O@777n޼yBuwnF1HHAD!D$A ,QU? =ڍ,\{M#4&csvϦ_!Y$*`clzpZ|g7͟ş^O(!jc"^ 1A @aZ[1cGbp: }:f@(&" `Y?nw#"}+O?q # lB`VGF]I'O.ڻwWMwnKV81 A!a@HH$ND06(wm5ƍǸq0n\=k_Ũ7 .AE0{qΜ98q cIr q`Q⟖02?sill ցUA/(! ! =A ĉQ8Ø1u7Ǐ wi|~_zh 3]X-(*wMKK&L0@=" UuǗu+ M6-z衇VZmAī Y/f zbDr"B A$ %#u Âaܧ /cBA/3˗/u`$gz d{(ԇHc⟜So"q%X;[| iĸb(B 1jУF]3C!Ƞ kj*1y8L2S4$ ?8wò`hY`&p# 5F V U( ?PF]tMkm[ː~7  Bb8 / xy$ D0ex0y< r{=ݻ΀e90 KD@ɥ7a̘j[#ijgf7Pjea8 7߹sMMM_2x<f$ X@:% I p@h!avA$['(ѵR`xL8"ev}{D.>݄bzmlV$8_rxi ?Eނr&`0 1p0L080@$2C@34Əɓa ?~&7V-|8XeA7+؛ B_k׮=u/@*S-KVѿUS,˲+++gp4<}{ADON-t0( &J <ɇ11QPS1c7e1*X%|9lf@WWa8<(5^l&e`׿.[x]:.\-| BV't$ EA\=>PVV[M767?"<5_=,o6Fw۷; |=Rp)J+d-[޴iӯY-LrUzf!ނ%{gDbE<q9c^en^s m X&[y޷|7okD@7B`VxEX5כj0mmmVWWwkjW(xu>\n-y AP$"||G\x1?~TS8w$We7oy/sxj`NzҺ_O1Tk%& 5P饗i`wYukff>l(jph hP4a@34rpNB8]Ep(,,AaQ) KPPTWa1E8Ҏ5"[PN,,CgC@#9ucw١RWWwK/*|#6&1l)09ד'`}_;/WWgMZi. e{G  yB>omAGˆ0!̇1cF#yFw \8gR>!( ? r .\psss/GF$&E({ S'4 / E4ϗ_q v] #J0L("G}}@^ogWk6 / H!0@8P8/:vG3p0 bϞ3`hFZ@ѹA77}ؗxuO쇼1no/$ vq*iq0Ŀb/ؖ {W v5iDD]]2cڻYx^@O]^twKۃn?l Ea!B?Ӎމ,/@0s'8=xb;!PWH r9 ;–-[_ԅݻMvIu'aL*,KC.{|AAQC 9Q h6x4o__^E=e#GVc tvzGgHy /uu5ʞ|[loś<${Q= oGr^yl&E@Ԯ7 0[T`nj^^B!on;IjwKfg N:QtQt{E_o CP6m@ L.D4fpe-O;q,Qd d]|A ß!x,XXSS_ jaJ2EQv{2j+h۸q l{-zr;?ej9-]4M9GJ@ĶX#m>_H+{ [>OjE4pӜq`aϾy20",fAS"DRg b,Xx-q\ƍWL:ǐ\#d(HE9Ua/One@9?W:f` ʘX()?1yH,`BEx0ZA˄m0ejG YɓWO~s~9_r `kꕒd]rn)KUMޞOihbm@E!|+ ?8 E_=0 SaF.)m߄ŋD@b~(vf,I&ݻ|r7F" ImiCR6ŷ ի?OӴ-kIGyIXIP~ >q ?3-AQ(ZH2![6]iV^y`s6$^rYզZ>5f]iKR9::zrՎ8 bә> !Z $(:D^\EGG-ظDeFrvO ۾ Q6F.f͚e4M|6Bؖoےm3>| (P㶻,쀦i5kB[)ko%v ~=-oZͣGvxXsI\L-@R,ıӈCOiP4f@4b-#g;};=oѣGl0в)0!nOmذa(7p~ٽ HT ͠y} oFx=M3`4Ɖu/v86lXP ȡlE!Gr9դvL²,=]I==>8?$"}R\y! ᕗM`h I"f@SRȊ0<9q==>[^{Y2ǡR;䲭_F7_%bϮs:ٸQACcV~|a^.z{=? fl4qdolDAĞ]`EEE /0'$ԦĐ>z2v̨W\d-k㥳XF5MӠN]F[[gO0L믽;hYXpii&{(!9~ (X IDAT[^;jKT 2{9EZh0~0F-C~SfZya19>"dZڼIT(J, }<7yufXP4PtfȖɍػ젪jw)6E_RA_r%&ɹH |sӍ‘Eɀ +h=agKpߋ>tvvʕN\tϷ".]nx~2}"Y0 er8˲`4ME͐-ۑ`Qb& KT?@rė(ز5 D=p(bKg! Tt5Csx?}O"._K.urU|~||$/#yccY.8r9*pr+;VPDIi1*+PUUbgDQ~;)SFgLsB;ٱfVCBiCgQq;A8 n!aTVU娬*.a7;wC`Y90@??Io-vwUV}rӦMh7=v+hzxGƞfؓWQK`d⺺^*((p( wOYY(E<F(Ek_N#ӧ/?܏oƹs▐FE˂0>z <>jȥ]^LG;ѽ(qQ^:A$TUfD%F5b(7 mTVMho\\Ep ti 8F &i~;*++ aM'o>yL2e1#WsǷ֯_?Go9_6'z^?x}7XvkOM^xx|(::rd4#M%cQq y0I0D$ TX=ި#܄2ꢈn/=hii"4ʊQ?ʍQnjpc(7FEaP6~}ԠY LOHdsyXpcׯ_? _ߐ@?nK*W('hX^dRcC/9@.-²>njĸ#3|nD"~عgh4Jưde4EKh( GGC[d@mr\@] LJ}NF=R{yE)F%q((x~|>ծp,Y .n%~^[YQӌ9r0!=٨'~5,Ct+X̒%Kx?PeW#g8?W2H$ 𣤔׾)* DQec掳\ 0q FFq_`kDQضm['$>@ևFj_);w|K.F\[ob"p뭓q=M>!߰qf  >9`9'8~) ``F(feZ V:p:ү^_#DŽ|-Ae?Q`hl_vӧy(""v:km%WŹif`A?Q_?"g7(x Jԍ 8gH0,_;*w9? \`~H/)<:@0A$"@ca`/ X9=z6!PUUR8rx__DIЇ0 BA$EGA D b  GoOHdXN F ~ ˂eĄ #0m,gvDMFи ޡA1HD@~ZK_aݺux}H= ^ݒxƊCXYKڒw%>$) #ezoތ{Id@Y;tH``85h~܋XyFFE;UЯTAz ha|bP!@ , bX@H){^hiia)aOc0,8΁qqÔjZ;;3jqL!+`H@O@q%,]tOn[G^zMӖJˈd?hdD㶿k+Q[[ѳ1#G/Y4ÁYP4 Pt["(^o%JˆDsH^)׀BA}Tܚ1É!^Xx%.8Q\@ieL;΍qqC 5 oV <AG/9c-}]W^pj6O+ ` l)JLy̙H5~o*q"@ `80gTf>O1Ԁ#W⌞E'@@qjgASp8p: QPPV K*[[”#0 e11nMX "!  '~ vˣ2uȔlÁRɲ&r'WP覦=٫pӃ+3&eTtq uˏ_/ YcmAň 9Q틋aD>ODAC3XiξIu/CVr9R2('5ە^\ TJҖ?4'ot}h ]Xy 5@GqNp_q-s( O1H$]&~܂( 2 A " x7r'{r9pǝ |PHDqj#!Bk[SSs ʠ y,0R-TO?uK@lE5ؤDWqpND~=VfԱXcAD04]Fgd1aB5>"@5Gwg5L0 &!!"! ͺKw(b~0?OxZ#@Rjf͚e?+V0 6K fZnKY날hM. /Cy~_? i}}?חg7ᠢ" 6+?:yu0R%j^x,h X]o¨뮊ZnS' 3-hzYÅ y3VYsq/1'c(}Y Z A{{KgN{+P;f# HB&C0wl[02}]wU@l%OZ@O:x̨5\mժUQ, .ᄤhiVˁcp8 pӋt3) xӷaTCx> rqtGQ*xz?=uuaDxB$>FmZ3El /CE~o?~/"o p?&_|AQ9=Nwy3X|k vZ?:Xz&5?drұP^+ƌdI?{#-0yW}/=uNUu컖HEImlYm 6$͍f $呐p0yk$0;68*ɲ־HqkQ9U'0Eu q $ j2* z 'L h1Qw#*KYjޛP.WBȶ~xc];I*j\L DAőCg>D"%-,]w_Y&0 -'&H lT9;iRH '",ƛo 8w!9iJ LrTo@<?؍ʔBrlC_P\L)z>яn?58dvг9KJy`ٱ & _܍{?yzzKO̅Q$RC*.*`'AP t* hlQ^{ D8iyzُdRũiGF- g}9(ط,0MoYbECԜ:O 8D01G9k6){Zð,;8_T*] pyx}&EdlBh*Lˬ5CLӄ#ʙnL(7ACuww^С7YGd-,06+_?ZQ*nn`vB02* ly'4-tzJQo1Rs* Eujَj/`(=/W9e6+t?Ӿw__ﲲ546Nm8zgZ&QPPA$x7ʼ%hh`N ӕy,L!9^* J@QRE8t dTu@dNB fu;zx(pR _7J@N\r&'h۸qcN&Dc L[GOtv`a,^Ø=~<* |T+z`:鉒Q "躚Mj=*`CU <1vYUR9+DPN20=lSZx 1<?F:];Xܽ Wn:eRvB<7@:M`Zon"2*ԡJnPoUUPP^]^L)dqvAc-(YKSFX%': ޽?=\ $/؊40~ Z[e(jʩX<*`t]kj&7@=*`V2x/C2 J耲0Tf~}ꪫ7?60P;2lRW 99axJ^j-X' tv7=Z׉Qf,=xv ?",]$J@R0 e>0 ?<Ȭe\~>,-j.5rl[dIU:NQdA"ŏ~^ (p;7@Ї &EbO  үfrٹ}Cak9@ e! 1<[Wd2]Vc^ֶSLt9!'j pjb C**!-\USVHzYڪYh{S;r,j_ﾻW Pny& X.aPD'NUGWW3>qX`/`?zdf:Jf* JY%@4`tL}lۺ#$5mCVU4)&E,XЊVN u`vTlw^tɮb4P\&NEƖ@1T?; %@ DX7xO:<|sGیx+e+p؁A`5  2r$)'~:W~,}g43 b,pkp@BJ eY R\Џ%Ki% hֵUPU+9V+ rp/EAHUt<9V;nLPyrA UA IDATLExQ߰ ?H'Ǡ*zzzD b8N y `)8fs=V`_SE\,/GR4K h ?gjʿlf5>r $TA:J5VtZJ y˅4ũn8T@uzؖÇ,B=ӏ@e-ݽ,/ fLV(Gb(~=D˖ⓟǰp" im X~^4 H+ *=2*`~,Y+NT@lp] =!\2,S^ŋ/p|%qi_n! D YBpE`c/~s,["44?~-_`Z,;`,%Z-m;*Jgس-X?WpfHáCa()$T= JÊV-G@2E1b@\ s*vIӧ¨cjpg%$:'~rMJ[n]pQ+W¶ ^+ *`[(\x:0+pL#h"GZ"uYXD9P ̺C\iBB²΁ED~F?GjZZZEyA!8% F` 8Na/@:kY MxcP+cnJ J:Mq%;Yӧ d;SB5lڴ9 ǃ\@/I"޶m{_oaǎk:ήfr|6~x-t#3: ulN kOCA2BM65%P\A Y*EmQ; pQp%Bq|GXyЇoDccCMF+I _v& P@ 7f* Uh3RX?wJ:I`Ltwk 22Tc~ `L|ߒXB?qN! !#ΥO?ʗ@]N!3i)-ŃHV\([׽0H#@ '"Dx|ŕW^X^zٹ?1> +0C)Q{'$S6x3(C`"$B iX6o˺j6f/VZݻaP&: /vE<7 n.&0l<נ #^w%l!a_JX|9}Ԁϟ``s.i5+(dcJpa+Z[* 55o)-tT7x N*Tbtd#@ KUb($ClL{)ڠg@푶$R) DmT2MwH,q3\PSQ(p>WmPzs tآtT 毘 'N'CHg>PJK90GrI(T(yAb(ٝȽ (JH,3HI!K LM3ẗ́uײ2J@/2'ym;SPIPF4]?y/ѭXtAc X׎%hA g3@ 4Cτ H+ 0Qe"ؾu/j}G1,G$mN&)]M5MA̶'=VX#dYE2KcR},[,*IRKP28^j|e|4*=5A$9=#(zaXuGA h4݄Kcx8K9J{ LJ!P 23{@g|y\8yr.Fhm )}a_+1> Q(> ,qMOy 1A# q[AaT\كF!0$\9=xp0X@e˖Eߟ@q P D1~E!>&}曻 HDD{{m \зdzc `LB4Z^˲1:H C $1

qu^=Jm͚:%@NFDj<6ՐL;)R*RVK)e7$TЛECKk۱hm;{fxx}}&&8| :q :–a#[wܱ 2MuK1o~+btDW]06Gk{LcA%sAp#&&*Oyr0G T KA3T@@hWmA7Tdj GZV^HRi$@I@-ecl<}1H;ѿMM3+fXj!VZ0 Gx{qwCxܳqquN˿R̛׆OFG/`Ș@JEC\5?{)% *JC?(:CF\P*2 2 028NWmۆa0Lxl< ˲!=W.V#o]{1SQSgw=imm 0654l0Fly7V%K;P7V (/]ؼe 1;n;|nąΜ@$*ᮻ7῞zO-6eU8 GCD.* %BDLx#|T5Kg=: :T (BX*<]4Gr֠}lX4Z[cבi8yחp/:PPί*s/]Xz>ο`d93ftv6ce+G;ǰtC 6oY\ cXruܛD$\xʲqβ^|7;6  %@NEN)Vs* /*@sG\6$g[SA d0xIn8zdZ1`F:Yj_h,Y :\1o~ q%>s֭_\g)c}a%NUjfTe 2TN'(I̽oZ~Xv)-ꀦIhZ:{-&o Uf:]DNva h!IR˒%K"Eӱ}JN*'FT8[O|W˗֝3-u^ B,䊀eYއI02 Z N'Vu9v Nzy Ą$V`M^+`۶a9 ߳2<ؑmӒSm' Iŋjr_[޳z\xb|3ף- 1m,AY8Jj!3Vٿi+ )\*:@U5`VmKi Z6Ooƚ M>Qى6}|3"1 4`ZlذlSk R*u*@ )2cvP$5 M`Z1qNL QΝKۆa ôRE.y\@!P*V{)D&ছVJ,[$%u ,Yҍ~&8ZeGTGw^'4UA:=5-x :^ }}4T%MM5X{u*bd|GJmdbUBFٚN, VH[Ԇ>/_Z.uhl^+\3PA02:djDI*`dor*@- 0X2f,_LyZvxd[]EPl 2h4P'dZt nz*{1#[nr0fNL/J LIu՚\TRNTQWo^]W)Z9Q,FT}7-~AвÑmSUve}_GMj"|73lᗧ@0<i'=m4*<'* L@Q m'n eXUMAQ`:LVRA"DYŲ-g4mAp'wҪDC$OvM[oo>~&̛xcu&|OnĚ5x9ӀmOnM޶-3JO۷ T%tjk8y"| neIN ^ʅda9 ( ۂNWŚt{P[ z߻WG( I +~0- NL:T4C^;ϳ$̷VۆE$B78hnnk7oł䌝`=n*040MAB-+>Ed[2 t:߰gM_GpŻ…>Ą A6PU`L#"PtNta[VEc P)Tð3*|˰k8> DP@Boma04 M™3Gsl'khiia&_.Tt- ܣVI.X[u;? ?38WmC3QVEm8y)$0&-|򄂣GX[nـol`DG/ hnꄪLnNձ/ZHD+ R*]BDߢ6uu_Gc6og ^ۧ}\]l%N2 8eT& ި  ߲llzՃG:P*Ukc--q\y5(AB Ր.+}{Q~ղL)! {> ltiUQGqhGp~Kl}gg΢ *?Y'X}}xO=d˂[?"8˻YhHy FӀs\(Ccn,YڈήBK֝ݻq'*@t|T@(!$70BY`KvVku V}غuxc/Nsq UyL]΀ 7SΜR=',OOn,s_@{YW9jL?6=A @d9QCb ք ؈o?T5͕&LհTCMRdYm6.mo}[_ߍ`ϞY83+DEo֖5e'~k(xXL~egC4YRqR&0hmP<*I`<LƄeSQ 7J]kz sCCضun݃bb"xBM+" y0Y-`&{.O]5ۗ{eo2 !33t^8" A7/YڈpX>G0*:JM$Gq_`CqNe̵TBxe̷m 8vx]8rx O03&:ߩL}ZN,Bv'%f(W Oe4I^e? t$}{Oe-9Cfȱkg_nB[s)P4( BD_턡IhBq膎T׭ G)̡2n:]iZ @C,}/0LL^pv:TDSg6qXKcYLh6|R!xܜUZeʸ{y9>*E6 R)q翃iZ.O/9}fyyx{Mqd6M vIC$)gL87L^7ef/hT~5 cg`@udXN0}pQqldG"ٍߎLJ16gB Iw eǫf`BGWLo=X\%`7< a^p2lB$Ley~'콜~e7 vɚcN(`.hkoW“O AKYS.j8;4ڈ8!&bgy0, aIX`+ ##N7N+[z3*r/YrS6H:*P' {ߋK7ݻbhT!5%g9e@CC0h<5A1umHI4-PkZqc0 D3gF l۶T``L(ʎ?YnMB#_G. x xY'OɦX‹ Bލ1jeRA$T -v#hQDeo n{tyo 0Mo<pg4M7qЉ̟ #9/Jr67ynu [SBa~Fd9H$YMJcU/ۛi*hZaG o X;n"ɄM>A[ ȶb'z+lL+`lP%X @Lm;X?ݟС!2$F Jng˻9nO8xsq@(`,YC_/mDＳFS+4qPIaidnRI|U\,Y8ETvϕ "t:P)>͘w:t:<)Q_zų]* W Ӱm끪#L7aPcD)I@rr6@]>45h_MRS_w݆EGCiZʡ47s HBeDв#*"P;X?)D"p xd? #Hfӟ(E!x ,tvNige~^K7-w.-P4T5 MW`:lۂ\I[ kHc"`L{*hQ@U*QRtl TDD*8t qJR)k/s ˕u :f#CfǡCȘEQ.nR\xq{VBp68d$@HD t.f{Tko1Ѓ TJm<88x~ֶjs4@?6__>31,gc63i_vL~xL B£T]~m)МQ Pu_LYǗį@5dGʿ˦I۬l̵O+mm g!يw?٫琦aؾuqUs?O+Zs=2<9Ç׆19Ke=xսxWk=,8pl[w%}r㘚Ƙ%f:pSp{2%W6ӧ*`XSi)ͦh_SgQǐ~iِ@ 8uj֠_sJ/Տ8 [o3ך[44[_;zfL HrԓϞCL# <x8xpCʢ^ MQa 'mǪˌ`6 ,dVڿWضT-9@g8p@4mTƆT$!N{?}Xч ;Ú@D"2, gov}?[Mg۷"@,G'Y1#<EAQ^½J+eԩ)XAM@S; ˜}:Ǔ td@ӴǗ##OF-yUKr@*:P-dܹy4|yЃ@CC *[1-Be?q|Gs˚pSau^~y7yx6  }f6o9-{}eփARNN<"rx zfCGV&&KϐR. >AˌT*u+ጠ\; Ի,(O$---=%@`Lɓɏ*wfӎw9pZ]z4!3Qe~F/8ŮbBtk: :Zp妕x" z{AQ!cG2#Hd ߻o[e)S}!_t_d` ,X` CGKk @`YQrV{S O>.ʕULwn}!drWgzeQl$E-q BfgzւAIp?{y2P+VbϮ8u*S%`2A4@u+_2A hi FFFP\ɆJiJӧO"@AKs>T@`T$<_ԩj/9]lنze-lcFqH&YPnurP\B8By 1IAd2 ۷P[:e5i>}&OK8 Joj[^j=G ]Sn#e) _E2?6l˶yӚZeWUۜ\ !1ȑ8D) 2cXi$9)%QL(v53gc}rMWL>Ξ!6ر#P ttTe&2NN;Y-+v ,Ӏe5`yo}T:IR'42/ Wڌ?k D1Y$LJSU%+޵=MAO4WQ YigY) P"TU^\=Ao%37o?嚋;.i,3HsRhx##8~lɘxNG"և*PXV̙y31;x9nw)h`@rBrtZ mL- یW@¦",&qePmr()O>a:yJ;U _Qtl{(dg2!@޳J/_l,d) Exl $Q-?mՂ+Z*0Qs +߿?cr+%˕ҝc^y&ygCs<&F ?sAV\~ Ka0-n`לë7D ]28F#("F_8}2?3PT= >qYk`w] ]=P4-UW`,?ݵVp2E5|Pt{]Oro>XJAFcLi$WO(~xO8nx&,SNN0Nf1 H{j?Ǐgc+ycJd4kJ/ rsY&0-9Q6pӿQadNؾ8+RKbĕ':!ɮ92] "1)+E1Y,W!Qgd堻WmZ MS4 Cs|~j=2%ʖ(,ClEr&gΝo107f'fL(Foo|N(˖/x,iiMe;۵MdCh4_)zbѷ(\Gq+T`E~*ql xPj%94MϷc-hYO)rdHB;(lgw[oA?AeL:D)gمo|Qlko&zZN0p6an=!3<8'D`L,7@XDȏ#Ch߿8B'7KR T > Аo| nrXZpK}e]dݵ{y!%-J[駟SU5PbwLNFp:@r^ym7dM$!5jp8CXjV S:o; ̯[cNȑp6 /gLRɩ_!# pU+; :PUu駟s-*K X2yll@i:x`a_;Ͽ B,O9)DBϼp_}0tCD c`T'0"d'q9-`d [U ?Ұ}11SM;O1#T~ Y ;b̝g׎[0>]iŕW^]S*IN誧`n, 92vZOw |v/^QwJo ^=W^y%pGe˻u9tΕ(D) QGCP//| Gs(UcpzC0  $^GcT?EZ;<\/J'.wa?xMi᪫W+kIh:-[9s0`{+{S =h۳۲m;is:kF@sh6{~طhA 7ݼeY,:[Uw> qwr7?r^\R?9tApꔊݻFV0FX4 uNP@`9۶~/^rww,j'.t@~$```@O$P4*b 79Ex}xt(Ex(PO~ %޽qǝ%RWBk[Iol?<"_Yi'"a3%Zȅ3vnmÕW+9`a+Q1m&:}v!_TC(WS{{-_]{{ v$,XB?3/|O}*j IbtK#w]FX˴`[[DDBKaD?TܕgQCf*N_$ Q0'.*F`υ شqnPS5u'Z^#l{(̽~OSD[݆ݻwT0ƲlyW&2Is5Hmp;Sνx 8( n_Pl,|};=HrMOh% *m'O(ػ'd2{6p(4w~`=w㮏nIJe̬@]A- Bh/iZK#y\*Nr[>Ov8$?L4T  jLI VTUu{IT \?/&/+AH)oܧ_ӁK˻jowm).("B( 1$&?/ OҐź^~(;y캯 ߾A9fcI#!2apDqiq ȘI#KΘ ]BȨ7EGg4-YT+@)WvdV2H?zox{2&>L< 54Lcx\}RJ { ɪ!#lۆe,i04 PaLS7\Z{F(:vy۶]'&ٿs B5߳{*PHR X \R^YEhK#p PI!mD,ڌH$$Ѐc+m۸rS7S&qߏAc =&>[pӻ/ax"%k&z8o=o@:g_DsAhkC%MT!|/(rq6l I?y{Y_jAʹxS7hbv BRT%,7a%ûqXWjE{ضmX*EF S 9Fxg;vsCn©#N}~2(~1W/;փQ >=O`֣1$Zެd)dg~L6^~ qLe~&f3[ǒ3+B?R sf5]0^s3tcVZm:4=Nb8t`{6f2O ]Jfsg `L'/]tK{o1Gvr;e~%9Z\I<0Kj=A~1c 1tV$"oQ[} t/({|LP~E) ~`'Jw )|l e2 в0p_Z=Pbؽ{'^Ta{ikXhy|7,ۆ@ޙIQ{WU;300 . Tp&*jT0U(Ęk4AVÀ 0>l][uuU=3sNU=ss 11KE-%Fsl}]3^~iϿk+l&!Ɩ3xQV+nU(}.llx&fM) {3^c:Ζ!ob HZW)?"wjGUUtf/}ey.;#Wgq`( Mbxc`h3v|شa~>jL*L6Cc|@m%,?hil$XMGqNe96l==Qn׿5Phk49z&_3B]m:35Z"ery*EPu5yŦo6!!9׿gH6 -#DGm`bށ/(=܀1#|CjjƎ냱8TV`9:x*,"8DE,(- qv$&0y?h0)X۟7OU}P֭qKN,,xy7~l t3h0Q+ !цܼdݏ[om& 辒1(7&@SS{܅ Q瞔,X 'kai#t&fHΩHNDòΜCQ 8zZ[[wy8]@8XSHK"-- β Z@SQlxť"6&=ُG8\qS=z',CLLblXcYq&`N'u툉I@-g:ir?r|"!!?'ֵ'@akxʲAyWl_ v7 8]1091sx8Zi ((HIuPQqG/gN׻GDSP(;dq Q_@MuK`RSΎEVvL!̆YZljzSbQg}|tq j%/@@k6Stu(;of~Os-:YOث!`0'**.*9|ǏU+<857tM@d6[5$QZ&ez+r,y ~Q銻_q?zqNpp>s>ｳ5o FzLةSk /WW(hn ;W\pՌQv}dowC4>uxk1iaLr鯬 8N 8v"v=xӐuu:8&V+b^~WW iG{G Z[vYoj"!cӁ7 p+ϝiİl˳`땺xPovi L+nb.@[w@eZ]j(v\vx fE3h3hivTU5_'7E jL fon8,N.*T'4ܻxę,,W=\'9{ h4c.dv8-h쑅ŸQX=}4iC؊}{`q9w8A,ŀ(厸w9ErRiW5G1`ֈ$BCƮ]jPHm@Y PRRw}FӴ6y.DG p9'# X00a2Qq88t<9?F]]An卼⻵k37 '7Ic,;veee _7P/6xz!''JU7%ϕdeއB X;ՓeޮIyy7~^5Ka8C?I;y4JBWGT m_T BlPjޜeΝO( 'O UsPq,hKpN,,t|oÐ!1lx1/F޹DA9{??'E!xҥSs\zt Ϡ4|߾}JJJ N4 ?ۡa%> (6Ҿ pA:F{;'Q8giIMG^~3Lgf# A9( /45G2Aطo:%-|-.Pjv@97:uj_|C;,{S׷yX@5z 7X̗x<_#\N^H !$'` 3a2;2q믿jH'GM?)4DҞ3 0@(+|k! Vإa  27g/1 BA7x>!TFa\ꕃ^rѣg6>8M^ŭsFbʵt?3g6?uJMԿ´f7f >5 ---]{=.O(q]C}? 4j2Yo'Apq. [} /4bǎCk( yy(,F޹(,E9[ld$aѣcj&"B#.ފ 9vii?| Z#@6 fkkk?}ukc=zw|YkwZ(X_5e/-\of;AA,A X m3Bj/ BX1kn>X㶶VnkkCߑ"@ؚ$;wλuS2t ?E[]C#yaLgbzxq^1zEr1pP/ FfVjX8YY?,YhybK3p~aQC} ?FoyL9sd+)WUCWV#XWa !. \en1ہc5hZD  Çc5wNVVEk-@ЛoY7DZvۭ+V8?V$//6R_Lx/?@Jhp)U+A%QNQ`08i$n*3,O$|f'>LS‡b^p O!?5?l @Qv_9?0WM_0c=HHb"އ& %ܣ\iwܻŁ iB`c:wcN'.|5߳Nƌ)o'tƍ/2!AMp _UkWMZOTLM;W?XSScHϮ{RB V[hBy(M1i4mØfddddd9K,,8X-qZ`fջ-q}1ؽ1$=&]7АcyB>~2]gGf%/%XCYt>LHIŘyQM*( U IDATSx (<{;fD {?Hmsaذ>^HJq4mE1 4BaHI5إ+ S 3B¦Cj7H ʴQap]wm9s)[*TJm+6pf)HKEFVƀHKK0#MSc#8fЌ4gTo"ڡi ]?Ȑc_t]wݵŌX-_X&E>=š=.sRǻ8v۶m+G]m>4iB|e㐖T:-iHHuvt8d09펧D х4FydD^X. ЕHy>(їm-Zh_=i0mp'¾ AhPi0/OS`h׾2i0& &`L4 >bkOlfg`2xQu cuS%H?!XnlEVAYI (zaq1R(=z >Pfju3B!!0|x>~}ZCDvN" FY+&2ncNӼ" 9vEEEz俘QW+.@EX_i@k@YOO>|p=MӺ7v((?އp\=]6 }3з_6Ban?[xXUe+C3`L&3L{N{!*mw2,ڟ|wkqA0p Y Rh#Xv?V}ۈCsB8 砨O&zDB-җK"ttQ6|8wE05X9f & xZdBy_ł'ȋ]&]@vӧg^z08,zb-ΟkA?k%ށi23ѫw&dOl.F|<47՛r巨k9dGIdX0f2A39x醌t:g͚5gڵ~PgH"iWF;VZx@T ۷ﷃM[ xo8tH' g8䤠Osѻw 2Hjj?*Oúugk6;2dPɞ«7E#Nن{2/P7ُPm*HUPB1 '*X0yԯj0׷`{ #~뙝=C:Gp,o|v4߲jF^~: 2QPLd" 6oKa!^?݃kZ{=Wcu͛4sEI!7 9l~6g~ƿPgą@gnOm Pؽ{Kn5V<ڍ8F?[E+7 3EQHOOBAA zfB,df -- qq9t(/?w8|$Xw~dIg3h Oڈ1c 3cwGwWW,0*6 PRRe˖L&S|*7_ވCؤ4A_) {bb,HOOBZzӓ^$ z?vǏñgp98~mmv\]5~ݭq&дkM hg'/ǔ7yܸq?D0*v (VEΝ;]vetX3O}'k8|{ g lw|1_ HLCF@(d$#==|rJ1!,pd;nCY45H졼}5ŸO6jeiw ױ -葊4mo~X>jԨV_4DҮu4ZO/laÆ%|PUG/bɳQ:OD@1AQ3l>A )^i`L4RSD$$"!!HLCbbӱq./ZZP[ӈ6xӵ5mDMujP L[L Ӽ~io3 i1I${Ϟ=M-SFT1M'-Vp8ڳz2-::={m 6%'&G8|ܶ߯[.4^(,|55M ? 1Hp@l1l6l6N[,f-&X&v5l+ܝNNN' Ó9yy ӉmhkiGk[;Z]mhmiG[[;:ڎv5gy_S]< >E_IS4(61 jRq 3m۶ mi'DЇy哓-Nz'>>g*Fss;ghnn7"3@\g^a<;c@<9弴6! D&tj.௄D V~*ίۯrPNOy>/J34y]%l{C3?8xvA[9 75꾼34/-RX bB_B 3re𥌹аC&-$jj "^ϟ?RVVVI* ?%h1 ,s|5p~^И󌿘UPb Ŀq#@yMy~r_> P^Cϫ Awx>)O],;;{!'k@x|BdɒeK.EQς;.O|!/8P~.;ČA9BB(~5<VR__31ؾ>R~?-K|4;.1sXd2Hk7o4z{<4Ӂ~7`[BUI>x{|]zШwb<ryo/(ygIE  7Xw#DR{ao_]$/f}J=!\;uqa?xԵ 2x/T Xv޼y7oX~E}G0{ gϞ䵪b@ ,̺ٸ.p٭gw>mGLUb䥔!J<8:4D[8YB}Oǃku8-<+f$&#F^a/MXjՅM6䵪"%%fa]B4BQ}XCϳiӦ7VZu@=Dk@{T\qi)E0LeM_v>#OA QC0# =GmmެӜHZN,@$_ Ӿ4hQn>?s/,kp/SBTз_&nu`Y־xǘzCfHz1rGA E-K.=cǎ7uCo`i0ƶ{رͥKnZ H Q!"Mޓ#y5Tf3:ujizzO/;ꆢ%P(E`|CS]]`~[[g_Eʛ,H{j@yujI /Twsv)ԛc|\u(YBDr 7v{3/uARAj#V& "*T*NbIK}9J_xW^E7?F@ Fq Ã`/~UPvkm6Q"YhSY_̙b]pIHK34I`cMEEź9slzv)إ^D=kSkM?nΝoʜ9Ӏghnj74` V@7lpĉ}x/[yp@ T3~Bqa9ƍN4c})/&8hIאG:WÓs(-R_$2iҤON8uw_;#.3"@ hbeսcr'N|=iҤO-_]VxP:C/ET ¼ #'ԡm/566^5g[0H 2G'O~w#VHS=DT?06Ou);ve;C OA^A$ YB=d,X, p4-XcǎGhI%VDi a,\L\<@@\[ouw̵Fmm ~sTW_2TGzzy~RSc ?q;wh 9(L2ik '`x` ܹsݗ]vټ`Y g4'ב! B؈O7 Q<G=؏TS 4ŨY 񕔔}MgyIxj5"@ j56M%%%oCzz`hS<={޽)))i{/NQ@ 1V ,!Csr#FxiHOB7!==<7-ln7.\Av/NV.WYw :P96Xy0rZ믿~rٲe,kvgLC~AJ8NG 8)xvɴ,k_lcIWud;uDM l4x׫Vv֬YO 0.]j|?]BoL)իtM_Cկ/%P3y+{'^صTNI #G`We۷o{II{rz]̠v: 'T{=hQQѴ n;(N{;lx$\$ ߿}=TTT|ާO\_mПR_0@'@"@xB/+x>'''<3g{OTAg<R.`ҾNn@;8AE ľH6#~ڵq̙777.`|A儀b`[teV5Míwb}Ѕ(`!{ǨoBhB׿by߆.b8O T#T{p{`OlB$!7#/+ڪ,X0_b_)Oנ? @{ q4HT~9_ odKX 8t*ܧ&@?< iiiii9_z_s0JdPHѕ?T<?-g@xP5h?W{iu]p:YpVCN En9 pEϝ;wڵkIDAT~p1d""IC$-wvAc-VZ1P6>`ĉ)~=NwƟ_݄ƶH@ @b .#H?ṡ7nX\j#b oC4]RZz(#G&~7/{@-X 8P~.'A0pP?< P[[oʔ)x0ZWAAtXE@qqqw}$sx`Yk>Y#@Po? {ŋw;12Iri?:p"g3Q_K $'1tX^Įܹs]~O' o?1a|"@mB 99ټsG{kW6`޳ `\hSb"v 5e~oC7]^Z6 +ȵrn|ݤI@ EaG9# 3n())y3BBP&( XjՔ3fMfU;?-ے=4 DXYooL7?b  !ET W^ye߿l6'zjǿ>_|^>%!R4 ^e˖=C_[_(2i@\}QVj <7M^z\U N؊I?*Ju]p#I~)1 Gn'jDɓSV\AAp{ :`/5+[~:h3RA.yuDٳm֭OOP|Ԏف %L E;k/OtUW=[YYنлi֐oư[ @P CĔ5rȻUܟtw8~&җB t:zJï~3#})8۵k[%%%o;1C˥EOcrt[*jci[o5;xd2%(=aY_+LJ{/@zbb͸meA͏hz} ok1D@t0#y^}(=pPWׂ܎[*"})Brո"uHIB.X˗Ap~=\ v{DI@;v Uzbߞ߾3 !jK¯{, hg?N8ɓ_:vX s'@pe"@kl n0aECXp8XY#::!bX,&2{8f 8slڴi٤I>zWZ?1Q<"(j./Y՚ƅ MX2|2җB Gļ_ 33:^k-[#<C"@L(W`˗/:==}c+Gc mХ(`(񣺺zyYvm5Է kzDa~:Gf6n8wDKS'=غ +LR4[GJ/;vxsĉ9Z?Tow+y @Egv 2Ds=7pO(k9~= Ac2јtu_̼y(#6e$.]:tO<g쥌~0_'_G@'I??]QQ jj.a}ׇN Մk --.җ#JEEźiӦСCF+K~Wc >1:@ :ZLڿ\@M+V8k֬Ef9zx46ag`B&&֌7Ab-җ#noZzs}\jbb2y!@` o喬OD[ K:r|~2!HHbڍq gHR]]{?Bp~-~9?d1aIF Y1`L6lm4hosO%җCƤƙCpjZ?XرI&}od?1a!eJAZP#mO>ԡ Qv']~.4Er݈̼y(f3ˑvŋ_\t 7RF_(9/fŌ1:@B" !Z L&t 5L10N'+#ؽ4Ns? Cc|L #}I8M61uOy3i1F~5_/UHjHD0%@0!W~M7ek^pQAcClo:җCc7(j={v<ʪU.@?XJ1 0Xxjb_w!GM1c|ŒpQSظ6o|EvjHrmJ?ZXZl-o$F)lf l @G@q=gΜŋh*M#ɢ.\hƅ&TU5y/65jM&I1ȈGVV2xE ze'|+VT!8W?~~4iDtoWA0y_|ϲX,gbGSS]KsS{@̽Ldb`vM&ڽ,HH!ѽ'Xbb3G_hѢU~# ~z|1 ;DDy5k%o@(b]ѣ7ߜ:f̘9qqqJ@,\tԶmVs='OlC^Km_J@E9421Ao?e +FPhDWM:uNZZ0C D-555{JKKWu][9cR'.Q@Eg-%ʴzBe?_M(4 3glzw?|BqbjI˭reD"ʴxʕRP+(9s2.\xoɒ~DBdhmm:p^zi݊+.@AWSW[+ľPHRejE)ezi#hf1˖-=u鹹Wv gϞOiiG[[ڍq_Z?@4A@xe` Ԧ)ԩSS~ r $K.ڻwg}Z71)LdRe;UDY% mڈӧO/((@t/X8uԦk׮}v#ZC ri2Jb Z?U zX<5lذŋ5jԤ4M&Bа,먪ڱs O>>BgtTUUP^^^[om=3鵄j(ʄۅeRy!1OY-}z߶mv={0H}VKw SC@ ~Z! ̇SUt,̢E'L0wC222Z4"F{{{ŋ;vlߦMG=5\/\Z,/U1"LZ}t32q]w̚5kfggIqϗyyyEbccs,K21---jkk9sbG?裊76wRC*ʵry([Mw"KB@F ~^πѢ@\iӦe :4G9)))]A x |ss/^T㯥L>j^jU"@a>Je´T\yNPM$iqy5F BMʴlB`'UmoTm;:AD"B@ eʴ>Pbӑ* &&/UfEN"!QښʍRik&W*7 n`kơ4`w&/pB@6 BI至AkmH1&mafKm DtEg! (1 MO#W󼍊GOA`8s2-w&/l@00xʵXx(KɕKQ@)x&/U&W-pg& W@B!*1P (6-#mC-! !,;@Z3 =CqvoNa MY\\H0#l0e "/T[{ge8^/4Pk3Cٲ3B(,a/WVrwT܍7 P"g O 3:jT]qH .ald@0$4T f"QZA! ٟda%ٙ?_G_qV!Qzo |РG5:&CGa)x:WA": P ! (yv+S`"t rIENDB`haskell-mode-13.14.2/images/haskell-mode-64x64.png000066400000000000000000000215471253441665600213650ustar00rootroot00000000000000PNG  IHDR@@iq AiCCPICC ProfileH wTSϽ7" %z ;HQIP&vDF)VdTG"cE b PQDE݌k 5ޚYg}׺PtX4X\XffGD=HƳ.d,P&s"7C$ E6<~&S2)212 "įl+ɘ&Y4Pޚ%ᣌ\%g|eTI(L0_&l2E9r9hxgIbטifSb1+MxL 0oE%YmhYh~S=zU&ϞAYl/$ZUm@O ޜl^ ' lsk.+7oʿ9V;?#I3eE妧KD d9i,UQ h A1vjpԁzN6p\W p G@ K0ށiABZyCAP8C@&*CP=#t] 4}a ٰ;GDxJ>,_“@FXDBX$!k"EHqaYbVabJ0՘cVL6f3bձX'?v 6-V``[a;p~\2n5׌ &x*sb|! ߏƿ' Zk! $l$T4QOt"y\b)AI&NI$R$)TIj"]&=&!:dGrY@^O$ _%?P(&OJEBN9J@y@yCR nXZOD}J}/G3ɭk{%Oחw_.'_!JQ@SVF=IEbbbb5Q%O@%!BӥyҸM:e0G7ӓ e%e[(R0`3R46i^)*n*|"fLUo՝mO0j&jajj.ϧwϝ_4갺zj=U45nɚ4ǴhZ ZZ^0Tf%9->ݫ=cXgN].[7A\SwBOK/X/_Q>QG[ `Aaac#*Z;8cq>[&IIMST`ϴ kh&45ǢYYF֠9<|y+ =X_,,S-,Y)YXmĚk]c}džjcΦ浭-v};]N"&1=xtv(}'{'IߝY) Σ -rqr.d._xpUەZM׍vm=+KGǔ ^WWbj>:>>>v}/avO8 FV> 2 u/_$\BCv< 5 ]s.,4&yUx~xw-bEDCĻHGKwFGEGME{EEKX,YFZ ={$vrK .3\rϮ_Yq*©L_wד+]eD]cIIIOAu_䩔)3ѩiB%a+]3='/40CiU@ёL(sYfLH$%Y jgGeQn~5f5wugv5k֮\۹Nw]m mHFˍenQQ`hBBQ-[lllfjۗ"^bO%ܒY}WwvwXbY^Ю]WVa[q`id2JjGէ{׿m>PkAma꺿g_DHGGu;776ƱqoC{P38!9 ҝˁ^r۽Ug9];}}_~imp㭎}]/}.{^=}^?z8hc' O*?f`ϳgC/Oϩ+FFGGόzˌㅿ)ѫ~wgbk?Jި9mdwi獵ޫ?cǑOO?w| x&mf2:Y~ pHYsTTyJdiTXtXML:com.adobe.xmp www.inkscape.org Ǧm\IDATx[ip\UzZ[X c0'lC6 UKPRL*"aBWRbbw#ٖ-˶}kVιOjIVH%u^wo&)aфM|555~W7uE'd7kMv}+W7q934@3&=+縝T4Hjx.zӗ3Е`5`+󷫦&m…ũNӆ6|Ẻi5 Bh,B\.8^*Ul? 6,/++[Yp8,l6M&h4;{c;w#_0?~±sqN=\{XpOV' Y>;wKKK7XVbed$(#200"^_#}nN8щF!ނ\ЙX̗sB lCRPA֭{IrO_s´tֺ!vz1??OɧPZ'?SmaUNNf.V4UXw;P5wtt_~ hR1:L# <P͛w'1dT\.%rC'Z۫ijxMKȩSϟ?/pKND0I'L%7|k> ΎAywQi:Im' Oa;d;&A}w1/w<9x T\%9Iufnoo dwrPj`2OAEGfٳGfSmB"p$j6/U[[ۏ$&.H}ʺNΝ;Wury.GF!v,_Q?>9wwn7.1Ip8-n7.QޟsF'tWʕe~b)RubK,DǕ-OvY%MI IC5*(;03<S`2LTߚq=>XAz%ߪatv^r\+uz3\7rʱ;1`gTÝ9ȿl<mpG='/NKIiE ӨMJ9R^m6buOZd/%#.q*S?xĬQ $+j/z(f{U by饗c1VFDBty{&$.Tv9b@/n`G\Spّg&UH8WZN6ɗ~H0ij<4hNF"fKP[F16~Ev h&}Sm, 2X)hBf ڽ{w++dU;L,V%%1ow3)$:.~ȶqhPq{r]5fM`ȚzP@g[zMR,=rh(7$GK0~b3]{g!b­hܑb n+ÿ.0 [߷HMOn]0a( Z;1zf8FmrQ- u.+n)F; yb o J0ȘA]^Dz~CinI '#Y :&·x M!D)6;j,($>j ӎyR=9M-9xM{{ULLĆ 3Guq >>t:S׸W *rA2zotY ALpm>#9 ֍"W k:*ҩ2@`S÷Ȱ@>8 4E|< ]Gܙ unsTYl!&bC5-ZJ9i_߈:eI%jTg7d l {>LxW)b|~FR@d *.D$7XfGLĦ~@Mvd;qD8-uHy^$ X>i B~ v 86iNIp6")Z\d!Zg|H1Od(Ĥ_O"|0[LHK?t[wqӯg~ 1ʳ nwD$#s$&l?ՏR/LW3Su|GhB`Cm8sl%,2?]?',qB56m3fxA(QXׇirMP^'XtP>Mi 2Wi)b"65IMMoi8- ;xQ/0nqGÇLw|4,`ewPA#^3xCν0p(TTJ>kGzD܍z`@g+1X^@jDe "$)N՗Abbl6MB0'g|C9°>=x'z`69 0y}xD4GLvLj9)FPsGk6^Q;v[&E92WԸG 1Em6\>kwU+ٞ0N#d}&]irݺr;4enEBvc*c2!k~P(p@Rlث-5GHѱVU&("R# e~{ ?ny*c'w'o`cV81af'''BQGR2 W'%\J{C#JA|ӰCrvN 1L2f as <~cklll<·NI:52n7~}b]w?`,]Z , 9#p.=,>c=/㓫pRrŇ`}N`48*}A9U7DXrĒPN ,c1Fp0" 7ܰ'c#k11YF̦ㄴϚ0+``K`"V#L-rgK~E`YCR֞> Y8}(W0"VwWӮJ9cDdS"1[W%琠/f`IShZɃgϾ嶸3:Em^0E᪪b8S[t76܁$J;pJRd/@.Pf3yuz유fޞ$=HZ3ncD 'Ă!ޓ"l c?ユŜ*OnR;8v)ȄC,e凇ޜI\98M`s>9zYv~xB.41~٬LaSXFFpiK iyt… < 1ᖶch$+Zho+G4dYAA~.銂;O[# @md asej3-#etJ2(}3-c/̂v n.\) vI)jKO?}#[~ f#Q}<)PTtQs!aSZC3삈88CM*9"[xZ%zz衭pi!?U)`ڋFȳ2GA02YB?[ܽv E#?_7Lmr?Cd5᛼k9?Hb/7-\Pw]\^[Od6o޼ -M*3@l& 544ܴijdXsʳf"{ 6 C.M! v~z<m4x$OuNWo:S~*5LD9 3g$AּOe%$NXZo}QBJbpv{ fU9돥UbCW"awo|[_UXMegBm!g)YSo|f5'$s|2*_X UTIs(ZTl0Chv|[ab|KDēJbAxoFJDl ЕbuVŊ&&&ѤB+:290٢7ldijvVmdTM$5;5e ՛&5]xRTFIENDB`haskell-mode-13.14.2/images/haskell-mode.svg000066400000000000000000000561711253441665600206100ustar00rootroot00000000000000 image/svg+xmlhaskell-mode-13.14.2/inf-haskell.el000066400000000000000000001071561253441665600167740ustar00rootroot00000000000000;;; inf-haskell.el --- Interaction with an inferior Haskell process ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: Haskell ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; The code is made of 2 parts: a major mode for the buffer that holds the ;; inferior process's session and a minor mode for use in source buffers. ;; Todo: ;; - Check out Shim for ideas. ;; - i-h-load-buffer and i-h-send-region. ;;; Code: (require 'comint) (require 'shell) ; For directory tracking. (require 'etags) (require 'haskell-compat) (require 'compile) (require 'haskell-mode) (require 'haskell-decl-scan) (require 'haskell-cabal) ;; Dynamically scoped variables. (defvar find-tag-marker-ring) (defgroup inferior-haskell nil "Settings for REPL interaction via `inferior-haskell-mode'" :link '(custom-manual "(haskell-mode)inferior-haskell-mode") :prefix "inferior-haskell-" :prefix "haskell-" :group 'haskell) ;; Here I depart from the inferior-haskell- prefix. ;; Not sure if it's a good idea. (defcustom haskell-program-name ;; Arbitrarily give preference to hugs over ghci. (or (cond ((executable-find "hugs") "hugs \"+.\"") ((executable-find "ghci") "ghci")) "hugs \"+.\"") "The name of the command to start the inferior Haskell process. The command can include arguments." ;; Custom only supports the :options keyword for a few types, e.g. not ;; for string. ;; :options '("hugs \"+.\"" "ghci") :group 'inferior-haskell :type '(choice string (repeat string))) (defconst inferior-haskell-info-xref-re "\t-- Defined at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\)\\(?:-\\([0-9]+\\)\\)?$") (defconst inferior-haskell-module-re "\t-- Defined in \\(.+\\)$" "Regular expression for matching module names in :info.") (defvar inferior-haskell-multiline-prompt-re "^\\*?[[:upper:]][\\._[:alnum:]]*\\(?: \\*?[[:upper:]][\\._[:alnum:]]*\\)*| " "Regular expression for matching multiline prompt (the one inside :{ ... :} blocks).") (defconst inferior-haskell-error-regexp-alist ;; The format of error messages used by Hugs. `(("^ERROR \"\\(.+?\\)\"\\(:\\| line \\)\\([0-9]+\\) - " 1 3) ;; Format of error messages used by GHCi. ("^\\(.+?\\):\\([0-9]+\\):\\(\\([0-9]+\\):\\)?\\( \\|\n *\\)\\(Warning\\)?" 1 2 4 ,@(if (fboundp 'compilation-fake-loc) '((6) nil (5 '(face nil font-lock-multiline t))))) ;; Runtime exceptions, from ghci. ("^\\*\\*\\* Exception: \\(.+?\\):(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\)): .*" 1 ,@(if (fboundp 'compilation-fake-loc) '((2 . 4) (3 . 5)) '(2 3))) ;; GHCi uses two different forms for line/col ranges, depending on ;; whether it's all on the same line or not :-( In Emacs-23, I could use ;; explicitly numbered subgroups to merge the two patterns. ("^\\*\\*\\* Exception: \\(.+?\\):\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\): .*" 1 2 ,(if (fboundp 'compilation-fake-loc) '(3 . 4) 3)) ;; Info messages. Not errors per se. ,@(when (fboundp 'compilation-fake-loc) `(;; Other GHCi patterns used in type errors. ("^[ \t]+at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\)$" 1 2 (3 . 4) 0) ;; Foo.hs:318:80: ;; Ambiguous occurrence `Bar' ;; It could refer to either `Bar', defined at Zork.hs:311:5 ;; or `Bar', imported from Bars at Frob.hs:32:0-16 ;; (defined at Location.hs:97:5) ("[ (]defined at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\))?$" 1 2 3 0) ("imported from .* at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\)$" 1 2 (3 . 4) 0) ;; Info xrefs. (,inferior-haskell-info-xref-re 1 2 (3 . 4) 0)))) "Regexps for error messages generated by inferior Haskell processes. The format should be the same as for `compilation-error-regexp-alist'.") (defcustom inferior-haskell-find-project-root t "If non-nil, try and find the project root directory of this file. This will either look for a Cabal file or a \"module\" statement in the file." :group 'inferior-haskell :type 'boolean) (define-derived-mode inferior-haskell-mode comint-mode "Inf-Haskell" "Major mode for interacting with an inferior Haskell process." :group 'inferior-haskell (set (make-local-variable 'comint-prompt-regexp) ;; Whay the backslash in [\\._[:alnum:]]? "^\\*?[[:upper:]][\\._[:alnum:]]*\\(?: \\*?[[:upper:]][\\._[:alnum:]]*\\)*\\( λ\\)?> \\|^λ?> $") (set (make-local-variable 'comint-input-autoexpand) nil) (add-hook 'comint-preoutput-filter-functions 'inferior-haskell-send-decl-post-filter) (add-hook 'comint-output-filter-functions 'inferior-haskell-spot-prompt nil t) ;; Setup directory tracking. (set (make-local-variable 'shell-cd-regexp) ":cd") (condition-case nil (shell-dirtrack-mode 1) (error ;The minor mode function may not exist or not accept an arg. (set (make-local-variable 'shell-dirtrackp) t) (add-hook 'comint-input-filter-functions 'shell-directory-tracker nil 'local))) ;; Setup `compile' support so you can just use C-x ` and friends. (set (make-local-variable 'compilation-error-regexp-alist) inferior-haskell-error-regexp-alist) (set (make-local-variable 'compilation-first-column) 0) ;GHCI counts from 0. (if (and (not (boundp 'minor-mode-overriding-map-alist)) (fboundp 'compilation-shell-minor-mode)) ;; If we can't remove compilation-minor-mode bindings, at least try to ;; use compilation-shell-minor-mode, so there are fewer ;; annoying bindings. (compilation-shell-minor-mode 1) ;; Else just use compilation-minor-mode but without its bindings because ;; things like mouse-2 are simply too annoying. (compilation-minor-mode 1) (let ((map (make-sparse-keymap))) (dolist (keys '([menu-bar] [follow-link])) ;; Preserve some of the bindings. (define-key map keys (lookup-key compilation-minor-mode-map keys))) (add-to-list 'minor-mode-overriding-map-alist (cons 'compilation-minor-mode map))))) (defun inferior-haskell-string-to-strings (string) "Split the STRING into a list of strings." (let ((i (string-match "[\"]" string))) (if (null i) (split-string string) ; no quoting: easy (append (unless (eq i 0) (split-string (substring string 0 i))) (let ((rfs (read-from-string string i))) (cons (car rfs) (inferior-haskell-string-to-strings (substring string (cdr rfs))))))))) (defun inferior-haskell-command (arg) (inferior-haskell-string-to-strings (if (null arg) haskell-program-name (read-string "Command to run haskell: " haskell-program-name)))) (defvar inferior-haskell-buffer nil "The buffer in which the inferior process is running.") (defun inferior-haskell-start-process (command) "Start an inferior haskell process. With universal prefix \\[universal-argument], prompts for a COMMAND, otherwise uses `haskell-program-name'. It runs the hook `inferior-haskell-hook' after starting the process and setting up the inferior-haskell buffer." (interactive (list (inferior-haskell-command current-prefix-arg))) (setq inferior-haskell-buffer (apply 'make-comint "haskell" (car command) nil (cdr command))) (with-current-buffer inferior-haskell-buffer (inferior-haskell-mode) (run-hooks 'inferior-haskell-hook))) (defun inferior-haskell-process (&optional arg) (or (if (buffer-live-p inferior-haskell-buffer) (get-buffer-process inferior-haskell-buffer)) (progn (let ((current-prefix-arg arg)) (call-interactively 'inferior-haskell-start-process)) ;; Try again. (inferior-haskell-process arg)))) ;;;###autoload (defalias 'run-haskell 'switch-to-haskell) ;;;###autoload (defun switch-to-haskell (&optional arg) "Show the inferior-haskell buffer. Start the process if needed." (interactive "P") (let ((proc (inferior-haskell-process arg))) (pop-to-buffer (process-buffer proc)))) (defcustom inferior-haskell-wait-and-jump nil "If non-nil, wait for file loading to terminate and jump to the error." :type 'boolean :group 'inferior-haskell) (defvar inferior-haskell-send-decl-post-filter-on nil) (make-variable-buffer-local 'inferior-haskell-send-decl-post-filter-on) (defun inferior-haskell-send-decl-post-filter (string) (when (and inferior-haskell-send-decl-post-filter-on #1=(string-match inferior-haskell-multiline-prompt-re string)) ;; deleting sequence of `%s|' multiline promts (while #1# (setq string (substring string (match-end 0)))) ;; deleting regular prompts (setq string (replace-regexp-in-string comint-prompt-regexp "" string) ;; turning off this post-filter inferior-haskell-send-decl-post-filter-on nil)) string) (defvar inferior-haskell-seen-prompt nil) (make-variable-buffer-local 'inferior-haskell-seen-prompt) (defun inferior-haskell-spot-prompt (string) (let ((proc (get-buffer-process (current-buffer)))) (when proc (save-excursion (goto-char (process-mark proc)) (if (re-search-backward comint-prompt-regexp (line-beginning-position) t) (setq inferior-haskell-seen-prompt t)))))) (defun inferior-haskell-wait-for-prompt (proc &optional timeout) "Wait until PROC sends us a prompt. The process PROC should be associated to a comint buffer." (with-current-buffer (process-buffer proc) (while (progn (goto-char comint-last-input-end) (not (or inferior-haskell-seen-prompt (setq inferior-haskell-seen-prompt (re-search-forward comint-prompt-regexp nil t)) (not (accept-process-output proc timeout)))))) (unless inferior-haskell-seen-prompt (error "Can't find the prompt")))) (defvar inferior-haskell-cabal-buffer nil) (defun inferior-haskell-cabal-of-buf (buf) (with-current-buffer buf (or (and (buffer-live-p inferior-haskell-cabal-buffer) inferior-haskell-cabal-buffer) (if (local-variable-p 'inferior-haskell-cabal-buffer ;; XEmacs needs this argument. (current-buffer)) inferior-haskell-cabal-buffer (set (make-local-variable 'inferior-haskell-cabal-buffer) (haskell-cabal-find-file)))))) (defun inferior-haskell-find-project-root (buf) (with-current-buffer buf (let* ( (cabal-file (inferior-haskell-cabal-of-buf buf)) (cabal (when cabal-file (find-file-noselect cabal-file))) ) (or (when cabal (with-current-buffer cabal (let ((hsd (haskell-cabal-get-setting "hs-source-dirs"))) (if (null hsd) ;; If there's a Cabal file with no Hs-Source-Dirs, then ;; just use the Cabal file's directory. default-directory ;; If there is an HSD, then check that it's an existing ;; dir (otherwise, it may be a list of dirs and we don't ;; know what to do with those). If it doesn't exist, then ;; give up. (if (file-directory-p hsd) (expand-file-name hsd)))))) ;; If there's no Cabal file or it's not helpful, try to look for ;; a "module" statement and count the number of "." in the ;; module name. (save-excursion (goto-char (point-min)) (let ((case-fold-search nil)) (when (re-search-forward "^module[ \t]+\\(\\(?:\\sw\\|[.]\\)+\\)" nil t) (let* ((dir default-directory) (module (match-string 1)) (pos 0)) (while (string-match "\\." module pos) (setq pos (match-end 0)) (setq dir (expand-file-name ".." dir))) ;; Let's check that the module name matches the file name, ;; otherwise the project root is probably not what we think. (if (eq t (compare-strings (file-name-sans-extension buffer-file-name) nil nil (expand-file-name (replace-regexp-in-string "\\." "/" module) dir) nil nil t)) dir ;; If they're not equal, it means the local directory ;; hierarchy doesn't match the module name. This seems ;; odd, so let's warn the user about it. May help us ;; debug this code as well. (message "Ignoring inconsistent `module' info: %s in %s" module buffer-file-name) nil))))))))) ;;;###autoload (defun inferior-haskell-load-file (&optional reload) "Pass the current buffer's file to the inferior haskell process. If prefix arg \\[universal-argument] is given, just reload the previous file." (interactive "P") ;; Save first, so we're sure that `buffer-file-name' is non-nil afterward. (save-buffer) (let ((buf (current-buffer)) (file buffer-file-name) (proc (inferior-haskell-process))) (if file (with-current-buffer (process-buffer proc) (compilation-forget-errors) (let ((parsing-end (marker-position (process-mark proc))) root) ;; Go to the root of the Cabal project, if applicable. (when (and inferior-haskell-find-project-root (setq root (inferior-haskell-find-project-root buf))) ;; Not sure if it's useful/needed and if it actually works. (unless (equal default-directory root) (setq default-directory root) (inferior-haskell-send-command proc (concat ":cd " default-directory))) (setq file (file-relative-name file))) (inferior-haskell-send-command proc (if reload ":reload" (concat ":load \"" ;; Espace the backslashes that may occur in file names. (replace-regexp-in-string "[\\\"]" "\\\\\&" file) "\""))) ;; Move the parsing-end marker *after* sending the command so ;; that it doesn't point just to the insertion point. ;; Otherwise insertion may move the marker (if done with ;; insert-before-markers) and we'd then miss some errors. (if (boundp 'compilation-parsing-end) (if (markerp compilation-parsing-end) (set-marker compilation-parsing-end parsing-end) (setq compilation-parsing-end parsing-end)))) (with-selected-window (display-buffer (current-buffer) nil 'visible) (goto-char (point-max))) ;; Use compilation-auto-jump-to-first-error if available. ;; (if (and (boundp 'compilation-auto-jump-to-first-error) ;; compilation-auto-jump-to-first-error ;; (boundp 'compilation-auto-jump-to-next)) ;; (setq compilation-auto-jump-to-next t) (when inferior-haskell-wait-and-jump (inferior-haskell-wait-for-prompt proc) (ignore-errors ;Don't beep if there were no errors. (next-error)))) (error "No file associated with buffer")))) (defvar inferior-haskell-run-command ":main") ;;;###autoload (defun inferior-haskell-load-and-run (command) "Pass the current buffer's file to haskell and then run a COMMAND." (interactive (list (if (and inferior-haskell-run-command (not current-prefix-arg)) inferior-haskell-run-command (read-string "Command to run: " nil nil inferior-haskell-run-command)))) (setq inferior-haskell-run-command command) (let* ((inferior-haskell-errors nil) (neh (lambda () (setq inferior-haskell-errors t)))) (unwind-protect (let ((inferior-haskell-wait-and-jump t)) (add-hook 'next-error-hook neh) (inferior-haskell-load-file)) (remove-hook 'next-error-hook neh)) (unless inferior-haskell-errors (inferior-haskell-send-command (inferior-haskell-process) command) (switch-to-haskell)))) (defun inferior-haskell-send-command (proc str) (setq str (concat str "\n")) (with-current-buffer (process-buffer proc) (inferior-haskell-wait-for-prompt proc) (goto-char (process-mark proc)) (insert-before-markers str) (move-marker comint-last-input-end (point)) (setq inferior-haskell-seen-prompt nil) (comint-send-string proc str))) (defun inferior-haskell-reload-file () "Tell the inferior haskell process to reread the current buffer's file." (interactive) (inferior-haskell-load-file 'reload)) (defun inferior-haskell-wrap-decl (code) "Wrap declaration code into :{ ... :}." (setq code (concat code "\n")) (concat ":{\n" (if (string-match (concat "^\\s-*" haskell-ds-start-keywords-re) code) ;; non-fun-decl code ;; fun-decl, wrapping into let { .. (; ..)* } (concat "let {\n" (mapconcat ;; adding 2 whitespaces to each line (lambda (decl) (mapconcat (lambda (s) (concat " " s)) (split-string decl "\n") "\n")) ;; splitting function case-decls (let (decls) (while (string-match "^\\(\\w+\\).*\n*\\(?:\\s-+.*\n+\\)*" code) (push (match-string 0 code) decls) (setq code (substring code (match-end 0)))) (reverse decls)) "\n;\n") "\n}")) "\n:}\n")) (defun inferior-haskell-flash-decl (start end &optional timeout) "Temporarily highlight declaration." (let ((overlay (make-overlay start end))) (overlay-put overlay 'face 'secondary-selection) (run-with-timer (or timeout 0.2) nil 'delete-overlay overlay))) ;;;###autoload (defun inferior-haskell-send-decl () "Send current declaration to inferior-haskell process." (interactive) (save-excursion (goto-char (1+ (point))) (let* ((proc (inferior-haskell-process)) (start (or (haskell-ds-backward-decl) (point-min))) (end (or (haskell-ds-forward-decl) (point-max))) (raw-decl (buffer-substring start end))) ;; enter multiline-prompt-cutting-mode (with-current-buffer (process-buffer proc) (setq inferior-haskell-send-decl-post-filter-on t)) ;; flash decl (inferior-haskell-flash-decl start end) ;; send decl (comint-send-string proc (inferior-haskell-wrap-decl raw-decl)) ;; send preview (inferior-haskell-send-command proc (let* ((str (remove ?\n raw-decl)) (len (min 15 (length str)))) (concat "-- evaluating {: " (substring str 0 len) (if (= 15 len) ".." "") " :}")))))) (defun inferior-haskell-get-result (inf-expr) "Submit the expression `inf-expr' to ghci and read the result." (let ((proc (inferior-haskell-process))) (with-current-buffer (process-buffer proc) (let ((parsing-end ; Remember previous spot. (marker-position (process-mark proc)))) (inferior-haskell-send-command proc inf-expr) ;; Find new point. (inferior-haskell-wait-for-prompt proc) (goto-char (point-max)) ;; Back up to the previous end-of-line. (end-of-line 0) ;; Extract the output (buffer-substring-no-properties (save-excursion (goto-char parsing-end) (line-beginning-position 2)) (point)))))) ;;;###autoload (defun inferior-haskell-type (expr &optional insert-value) "Query the haskell process for the type of the given expression. If optional argument `insert-value' is non-nil, insert the type above point in the buffer. This can be done interactively with the \\[universal-argument] prefix. The returned info is cached for reuse by `haskell-doc-mode'." (interactive (let ((sym (haskell-ident-at-point))) (list (read-string (if sym (format "Show type of (default %s): " sym) "Show type of: ") nil nil sym) current-prefix-arg))) (if (string-match "\\`\\s_+\\'" expr) (setq expr (concat "(" expr ")"))) (let ((type (inferior-haskell-get-result (concat ":type " expr)))) (if (not (string-match (concat "^\\(" (regexp-quote expr) "[ \t\n]+\\(::\\|∷\\)[ \t\n]*\\(.\\|\n\\)*\\)") type)) (error "No type info: %s" type) (progn (setf type (match-string 1 type)) ;; Cache for reuse by haskell-doc. (when (and (boundp 'haskell-doc-mode) haskell-doc-mode (boundp 'haskell-doc-user-defined-ids) ;; Haskell-doc only works for idents, not arbitrary expr. (string-match "\\`(?\\(\\s_+\\|\\(\\sw\\|\\s'\\)+\\)?[ \t]*\\(::\\|∷\\)[ \t]*" type)) (let ((sym (match-string 1 type))) (setq haskell-doc-user-defined-ids (cons (cons sym (substring type (match-end 0))) (delq (assoc sym haskell-doc-user-defined-ids) haskell-doc-user-defined-ids))))) (if (called-interactively-p 'any) (message "%s" type)) (when insert-value (beginning-of-line) (insert type "\n")) type)))) ;;;###autoload (defun inferior-haskell-kind (type) "Query the haskell process for the kind of the given expression." (interactive (let ((type (haskell-ident-at-point))) (list (read-string (if type (format "Show kind of (default %s): " type) "Show kind of: ") nil nil type)))) (let ((result (inferior-haskell-get-result (concat ":kind " type)))) (if (called-interactively-p 'any) (message "%s" result)) result)) ;;;###autoload (defun inferior-haskell-info (sym) "Query the haskell process for the info of the given expression." (interactive (let ((sym (haskell-ident-at-point))) (list (read-string (if sym (format "Show info of (default %s): " sym) "Show info of: ") nil nil sym)))) (let ((result (inferior-haskell-get-result (concat ":info " sym)))) (if (called-interactively-p 'any) (message "%s" result)) result)) ;;;###autoload (defun inferior-haskell-find-definition (sym) "Attempt to locate and jump to the definition of the given expression." (interactive (let ((sym (haskell-ident-at-point))) (list (read-string (if sym (format "Find definition of (default %s): " sym) "Find definition of: ") nil nil sym)))) (let ((info (inferior-haskell-info sym))) (if (not (string-match inferior-haskell-info-xref-re info)) (error "No source information available") (let ((file (match-string-no-properties 1 info)) (line (string-to-number (match-string-no-properties 2 info))) (col (string-to-number (match-string-no-properties 3 info)))) (when file (with-current-buffer (process-buffer (inferior-haskell-process)) ;; The file name is relative to the process's cwd. (setq file (expand-file-name file))) ;; Push current location marker on the ring used by `find-tag' (require 'etags) (xref-push-marker-stack) (pop-to-buffer (find-file-noselect file)) (when line (goto-char (point-min)) (forward-line (1- line)) (when col (move-to-column col)))))))) ;;; Functions to find the documentation of a given function. ;; ;; TODO for this section: ;; ;; * Support fetching of local Haddock docs pulled directly from source files. ;; * Display docs locally? w3m? (defcustom inferior-haskell-use-web-docs 'fallback "Whether to use the online documentation. Possible values: `never', meaning always use local documentation, unless the local file doesn't exist, when do nothing, `fallback', which means only use the online documentation when the local file doesn't exist, or `always', meaning always use the online documentation, regardless of existance of local files. Default is `fallback'." :group 'inferior-haskell :type '(choice (const :tag "Never" never) (const :tag "As fallback" fallback) (const :tag "Always" always))) (defcustom inferior-haskell-web-docs-base "http://haskell.org/ghc/docs/latest/html/libraries/" "The base URL of the online libraries documentation. This will only be used if the value of `inferior-haskell-use-web-docs' is `always' or `fallback'." :group 'inferior-haskell :type 'string) (defcustom haskell-package-manager-name "ghc-pkg" "Name of the program to consult regarding package details." :group 'inferior-haskell :type 'string) (defcustom haskell-package-conf-file (condition-case nil (with-temp-buffer (call-process "ghc" nil t nil "--print-libdir") (expand-file-name "package.conf" (buffer-substring (point-min) (1- (point-max))))) ;; Don't use `ignore-errors' because this form is not byte-compiled :-( (error nil)) "Where the package configuration file for the package manager resides. By default this is set to `ghc --print-libdir`/package.conf." :group 'inferior-haskell :type 'string) (defun inferior-haskell-get-module (sym) "Fetch the module in which SYM is defined." (let ((info (inferior-haskell-info sym))) (unless (string-match inferior-haskell-module-re info) (error "No documentation information available. Did you forget to C-c C-l?")) (let* ((module-name (match-string-no-properties 1 info)) (first-character (substring module-name 0 1))) ;; Handles GHC 7.4.1+ which quotes module names like ;; `System.Random', whereas previous GHC did not quote at all. (if (or (string= "`" first-character) (string= "‘" first-character)) (substring module-name 1 (- (length module-name) 1)) module-name)))) (defun inferior-haskell-query-ghc-pkg (&rest args) "Send ARGS to `haskell-package-manager-name'. Insert the output into the current buffer." (apply 'call-process haskell-package-manager-name nil t nil args)) (defun inferior-haskell-get-package-list () "Get the list of packages from `haskell-package-manager-name'." (with-temp-buffer (inferior-haskell-query-ghc-pkg "--simple-output" "list") (split-string (buffer-substring (point-min) (point-max))))) (defun inferior-haskell-compute-module-alist () "Compute a list mapping modules to package names and haddock URLs using ghc-pkg." (message "Generating module alist...") (let ((module-alist ())) (with-temp-buffer (dolist (package (inferior-haskell-get-package-list)) (erase-buffer) (inferior-haskell-query-ghc-pkg "describe" package) (let ((package-w/o-version (replace-regexp-in-string "[-.0-9]*\\'" "" package)) ;; Find the Haddock documentation URL for this package (haddock (progn (goto-char (point-min)) (when (re-search-forward "haddock-html:[ \t]+\\(.*[^ \t\n]\\)" nil t) (match-string 1))))) ;; Fetch the list of exposed modules for this package (goto-char (point-min)) (when (re-search-forward "^exposed-modules:\\(.*\\(\n[ \t].*\\)*\\)" nil t) (dolist (module (split-string (match-string 1))) (push (list module package-w/o-version haddock) module-alist))))) (message "Generating module alist... done") module-alist))) (defcustom inferior-haskell-module-alist-file ;; (expand-file-name "~/.inf-haskell-module-alist") (expand-file-name (concat "inf-haskell-module-alist-" (number-to-string (user-uid))) temporary-file-directory) "Where to save the module -> package lookup table. Set this to nil to never cache to a file." :group 'inferior-haskell :type '(choice (const :tag "Don't cache to file" nil) string)) (defvar inferior-haskell-module-alist nil "Association list of modules to their packages. Each element is of the form (MODULE PACKAGE HADDOCK), where MODULE is the name of a module, PACKAGE is the package it belongs to, and HADDOCK is the path to that package's Haddock documentation. This is calculated on-demand using `inferior-haskell-compute-module-alist'. It's also cached in the file `inferior-haskell-module-alist-file', so that it can be obtained more quickly next time.") (defun inferior-haskell-module-alist () "Get the module alist from cache or ghc-pkg's info." (or ;; If we already have computed the alist, use it... inferior-haskell-module-alist (setq inferior-haskell-module-alist (or ;; ...otherwise try to read it from the cache file... (and inferior-haskell-module-alist-file (file-readable-p inferior-haskell-module-alist-file) (file-newer-than-file-p inferior-haskell-module-alist-file haskell-package-conf-file) (with-temp-buffer (insert-file-contents inferior-haskell-module-alist-file) (goto-char (point-min)) (prog1 (read (current-buffer)) (message "Read module alist from file cache.")))) ;; ...or generate it again and save it in a file for later. (let ((alist (inferior-haskell-compute-module-alist))) (when inferior-haskell-module-alist-file (with-temp-buffer (print alist (current-buffer)) ;; Do the write to a temp file first, then rename it. ;; This makes it more atomic, and suffers from fewer security ;; holes related to race conditions if the file is in /tmp. (let ((tmp (make-temp-file inferior-haskell-module-alist-file))) (write-region (point-min) (point-max) tmp) (rename-file tmp inferior-haskell-module-alist-file 'ok-if-already-exists)))) alist))))) (defvar inferior-haskell-ghc-internal-ident-alist ;; FIXME: Fill this table, ideally semi-automatically. '(("GHC.Base.return" . "Control.Monad.return") ("GHC.Base.String" . "Data.String.String") ("GHC.List" . "Data.List"))) (defun inferior-haskell-map-internal-ghc-ident (ident) "Try to translate some internal GHC identifier to its alter ego in haskell docs." (let ((head ident) (tail "") remapped) (while (and (not (setq remapped (cdr (assoc head inferior-haskell-ghc-internal-ident-alist)))) (string-match "\\.[^.]+\\'" head)) (setq tail (concat (match-string 0 head) tail)) (setq head (substring head 0 (match-beginning 0)))) (concat (or remapped head) tail))) ;;;###autoload (defun inferior-haskell-find-haddock (sym) "Find and open the Haddock documentation of SYM. Make sure to load the file into GHCi or Hugs first by using C-c C-l. Only works for functions in a package installed with ghc-pkg, or whatever the value of `haskell-package-manager-name' is. This function needs to find which package a given module belongs to. In order to do this, it computes a module-to-package lookup alist, which is expensive to compute (it takes upwards of five seconds with more than about thirty installed packages). As a result, we cache it across sessions using the cache file referenced by `inferior-haskell-module-alist-file'. We test to see if this is newer than `haskell-package-conf-file' every time we load it." (interactive (let ((sym (haskell-ident-at-point))) (list (read-string (if sym (format "Find documentation of (default %s): " sym) "Find documentation of: ") nil nil sym)))) (let* (;; Find the module and look it up in the alist (module (inferior-haskell-get-module sym)) (full-name (inferior-haskell-map-internal-ghc-ident (concat module "." sym))) (success (string-match "\\(.*\\)\\.\\(.*\\)" full-name)) (module (match-string 1 full-name)) (sym (match-string 2 full-name)) (alist-record (assoc module (inferior-haskell-module-alist))) (package (nth 1 alist-record)) (file-name (concat (subst-char-in-string ?. ?- module) ".html")) (local-path (concat (nth 2 alist-record) "/" file-name)) (url (if (or (eq inferior-haskell-use-web-docs 'always) (and (not (file-exists-p local-path)) (eq inferior-haskell-use-web-docs 'fallback))) (concat inferior-haskell-web-docs-base package "/" file-name) (and (file-exists-p local-path) (concat "file://" local-path)))) ;; Jump to the symbol within Haddock. (url (concat url "#v:" sym))) (if url (browse-url url) (error "Local file doesn't exist")))) (defvar inf-haskell-mode-map (let ((map (make-sparse-keymap))) ;; (define-key map [?\M-C-x] 'inferior-haskell-send-defun) ;; (define-key map [?\C-x ?\C-e] 'inferior-haskell-send-last-sexp) ;; (define-key map [?\C-c ?\C-r] 'inferior-haskell-send-region) (define-key map [?\C-x ?\C-d] 'inferior-haskell-send-decl) (define-key map [?\C-c ?\C-z] 'switch-to-haskell) (define-key map [?\C-c ?\C-l] 'inferior-haskell-load-file) ;; I think it makes sense to bind inferior-haskell-load-and-run to C-c ;; C-r, but since it used to be bound to `reload' until June 2007, I'm ;; going to leave it out for now. ;; (define-key map [?\C-c ?\C-r] 'inferior-haskell-load-and-run) (define-key map [?\C-c ?\C-b] 'switch-to-haskell) ;; (define-key map [?\C-c ?\C-s] 'inferior-haskell-start-process) ;; That's what M-; is for. (define-key map (kbd "C-c C-t") 'inferior-haskell-type) (define-key map (kbd "C-c C-i") 'inferior-haskell-info) (define-key map (kbd "C-c M-.") 'inferior-haskell-find-definition) (define-key map (kbd "C-c C-d") 'inferior-haskell-find-haddock) (define-key map [?\C-c ?\C-v] 'haskell-check) map) "Keymap for using inf-haskell.") ;;;###autoload (define-minor-mode inf-haskell-mode "Minor mode for enabling inf-haskell process interaction." :lighter " Inf-Haskell" :keymap inf-haskell-mode-map) (provide 'inf-haskell) ;;; inf-haskell.el ends here haskell-mode-13.14.2/logo.svg000066400000000000000000000026601253441665600157300ustar00rootroot00000000000000 haskell-mode-13.14.2/tests/000077500000000000000000000000001253441665600154055ustar00rootroot00000000000000haskell-mode-13.14.2/tests/compat/000077500000000000000000000000001253441665600166705ustar00rootroot00000000000000haskell-mode-13.14.2/tests/compat/cl-lib.el000066400000000000000000000303641253441665600203620ustar00rootroot00000000000000;;; cl-lib.el --- Properly prefixed CL functions and macros -*- coding: utf-8 -*- ;; Copyright (C) 2012, 2013, 2014 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; vcomment: Emacs-24.3's version is 1.0 so this has to stay below. ;; Version: 0.5 ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; This is a forward compatibility package, which provides (a subset of) the ;; features of the cl-lib package introduced in Emacs-24.3, for use on ;; previous emacsen. ;; Make sure this is installed *late* in your `load-path`, i.e. after Emacs's ;; built-in .../lisp/emacs-lisp directory, so that if/when you upgrade to ;; Emacs-24.3, the built-in version of the file will take precedence, otherwise ;; you could get into trouble (although we try to hack our way around the ;; problem in case it happens). ;; This code is largely copied from Emacs-24.3's cl.el, with the alias bindings ;; simply reversed. ;;; Code: ;; We need to handle the situation where this package is used with an Emacs ;; that comes with a real cl-lib (i.e. ≥24.3). ;; First line of defense: try to make sure the built-in cl-lib comes earlier in ;; load-path so we never get loaded: ;;;###autoload (let ((d (file-name-directory #$))) ;;;###autoload (when (member d load-path) ;;;###autoload (setq load-path (append (remove d load-path) (list d))))) (when (functionp 'macroexp--compiler-macro) ;; `macroexp--compiler-macro' was introduced as part of the big CL ;; reorganization which moved/reimplemented some of CL into core (mostly the ;; setf and compiler-macro support), so its presence indicates we're running ;; in an Emacs that comes with the new cl-lib.el, where this file should ;; never be loaded! (message "Real cl-lib shadowed by compatibility cl-lib? (%s)" load-file-name) (when load-file-name ;; (message "Let's try to patch things up") (let ((loaddir (file-name-directory load-file-name)) load-path-dir) ;; Find the problematic directory from load-path. (dolist (dir load-path) (if (equal loaddir (expand-file-name (file-name-as-directory dir))) (setq load-path-dir dir))) (when load-path-dir ;; (message "Let's move the offending dir to the end") (setq load-path (append (remove load-path-dir load-path) (list load-path-dir))) ;; Here we could manually load cl-lib and then return immediately. ;; But Emacs currently doesn't provide any way for a file to "return ;; immediately", so instead we make sure the rest of the file does not ;; throw away any pre-existing definition. )))) (require 'cl) ;; Some of Emacs-24.3's cl.el definition are not just aliases, because either ;; the feature was dropped from cl-lib.el or because the cl-lib version is ;; not fully compatible. ;; Let's just not include them here, since it is very important that if code ;; works with this cl-lib.el it should also work with Emacs-24.3's cl-lib.el, ;; whereas the reverse is much less important. (dolist (var '( ;; loop-result-var ;; loop-result ;; loop-initially ;; loop-finally ;; loop-bindings ;; loop-args ;; bind-inits ;; bind-block ;; lambda-list-keywords float-negative-epsilon float-epsilon least-negative-normalized-float least-positive-normalized-float least-negative-float least-positive-float most-negative-float most-positive-float ;; custom-print-functions )) (let ((new (intern (format "cl-%s" var)))) (unless (boundp new) (defvaralias new var)))) ;; The following cl-lib functions were already defined in the old cl.el, ;; with a different meaning: ;; - cl-position and cl-delete-duplicates ;; the two meanings are clearly different, but we can distinguish which was ;; meant by looking at the arguments. ;; - cl-member ;; the old meaning hasn't been used for a long time and is a subset of the ;; new, so we can simply override it. ;; - cl-adjoin ;; the old meaning is actually the same as the new except for optimizations. (dolist (fun '( (get* . cl-get) (random* . cl-random) (rem* . cl-rem) (mod* . cl-mod) (round* . cl-round) (truncate* . cl-truncate) (ceiling* . cl-ceiling) (floor* . cl-floor) (rassoc* . cl-rassoc) (assoc* . cl-assoc) ;; (member* . cl-member) ;Handle specially below. (delete* . cl-delete) (remove* . cl-remove) (defsubst* . cl-defsubst) (sort* . cl-sort) (function* . cl-function) (defmacro* . cl-defmacro) (defun* . cl-defun) (mapcar* . cl-mapcar) remprop getf tailp list-length nreconc revappend concatenate subseq random-state-p make-random-state signum isqrt lcm gcd notevery notany every some mapcon mapcan mapl maplist map equalp coerce tree-equal nsublis sublis nsubst-if-not nsubst-if nsubst subst-if-not subst-if subsetp nset-exclusive-or set-exclusive-or nset-difference set-difference nintersection intersection nunion union rassoc-if-not rassoc-if assoc-if-not assoc-if member-if-not member-if merge stable-sort search mismatch count-if-not count-if count position-if-not position-if ;; position ;Handle specially via defadvice below. find-if-not find-if find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not substitute-if substitute ;; delete-duplicates ;Handle specially via defadvice below. remove-duplicates delete-if-not delete-if remove-if-not remove-if replace fill reduce compiler-macroexpand define-compiler-macro assert check-type typep deftype defstruct callf2 callf letf* letf rotatef shiftf remf psetf declare the locally multiple-value-setq multiple-value-bind symbol-macrolet macrolet progv psetq do-all-symbols do-symbols dotimes dolist do* do loop return-from return block etypecase typecase ecase case load-time-value eval-when destructuring-bind gentemp gensym pairlis acons subst ;; adjoin ;It's already defined. copy-list ldiff list* cddddr cdddar cddadr cddaar cdaddr cdadar cdaadr cdaaar cadddr caddar cadadr cadaar caaddr caadar caaadr caaaar cdddr cddar cdadr cdaar caddr cadar caadr caaar tenth ninth eighth seventh sixth fifth fourth third endp rest second first svref copy-seq evenp oddp minusp plusp floatp-safe declaim proclaim nth-value multiple-value-call multiple-value-apply multiple-value-list values-list values pushnew decf incf dolist dotimes )) (let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun))) (intern (format "cl-%s" fun))))) (if (fboundp new) (unless (or (eq (symbol-function new) fun) (eq new (and (symbolp fun) (fboundp fun) (symbol-function fun)))) (message "%S already defined, not rebinding" new)) (defalias new fun)))) (unless (symbolp (symbol-function 'position)) (autoload 'cl-position "cl-seq") (defadvice cl-position (around cl-lib (cl-item cl-seq &rest cl-keys) activate) (let ((argk (ad-get-args 2))) (if (or (null argk) (keywordp (car argk))) ;; This is a call to cl-lib's `cl-position'. (setq ad-return-value (apply #'position (ad-get-arg 0) (ad-get-arg 1) argk)) ;; Must be a call to cl's old `cl-position'. ad-do-it)))) (unless (symbolp (symbol-function 'delete-duplicates)) (autoload 'cl-delete-duplicates "cl-seq") (defadvice cl-delete-duplicates (around cl-lib (cl-seq &rest cl-keys) activate) (let ((argk (ad-get-args 1))) (if (or (null argk) (keywordp (car argk))) ;; This is a call to cl-lib's `cl-delete-duplicates'. (setq ad-return-value (apply #'delete-duplicates (ad-get-arg 0) argk)) ;; Must be a call to cl's old `cl-delete-duplicates'. ad-do-it)))) (when (or (not (fboundp 'cl-member)) (eq (symbol-function 'cl-member) #'memq)) (defalias 'cl-member #'member*)) ;; `cl-labels' is not 100% compatible with `labels' when using dynamic scoping ;; (mostly because it does not turn lambdas that refer to those functions into ;; closures). OTOH it is compatible when using lexical scoping. (unless (fboundp 'cl-labels) (defmacro cl-labels (&rest args) (unless (and (boundp 'lexical-binding) lexical-binding) ;; We used to signal an error rather than a message, but in many uses of ;; cl-labels, the value of lexical-binding doesn't actually matter. ;; More importantly, the value of `lexical-binding' here is unreliable ;; (it does not necessarily reflect faithfully whether the output of this ;; macro will be interpreted as lexically bound code or not). (message "This `cl-labels' requires `lexical-binding' to be non-nil")) `(labels ,@args))) (provide 'cl-lib) ;;; cl-lib.el ends here haskell-mode-13.14.2/tests/compat/el-mock.el000066400000000000000000000572561253441665600205600ustar00rootroot00000000000000;;; el-mock.el --- Tiny Mock and Stub framework in Emacs Lisp ;; Copyright (C) 2008, 2010, 2012 rubikitch ;; Author: rubikitch ;; Maintainer: Johan Andersson ;; Version: 1.25.0 ;; Keywords: lisp, testing, unittest ;; URL: http://github.com/rejeep/el-mock.el ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; Emacs Lisp Mock is a library for mocking and stubbing using ;; readable syntax. Most commonly Emacs Lisp Mock is used in ;; conjunction with Emacs Lisp Expectations, but it can be used in ;; other contexts. ;;; Commands: ;; ;; Below are complete command list: ;; ;; ;;; Customizable Options: ;; ;; Below are customizable option list: ;; ;; Emacs Lisp Mock provides two scope interface of mock and stub: ;; `with-mock' and `mocklet'. `with-mock' only defines a ;; scope. `mocklet' is more sophisticated interface than `with-mock': ;; `mocklet' defines local mock and stub like `let', `flet', and ;; `macrolet'. ;; Within `with-mock' body (or argument function specified in ;; `mock-protect'), you can create a mock and a stub. To create a ;; stub, use `stub' macro. To create a mock, use `mock' macro. ;; For further information: see docstrings. ;; [EVAL IT] (describe-function 'with-mock) ;; [EVAL IT] (describe-function 'mocklet) ;; [EVAL IT] (describe-function 'stub) ;; [EVAL IT] (describe-function 'mock) ;;; Bug Report: ;; ;; If you have problem, send a bug report via M-x mock-send-bug-report. ;; The step is: ;; 0) Setup mail in Emacs, the easiest way is: ;; (setq user-mail-address "your@mail.address") ;; (setq user-full-name "Your Full Name") ;; (setq smtpmail-smtp-server "your.smtp.server.jp") ;; (setq mail-user-agent 'message-user-agent) ;; (setq message-send-mail-function 'message-smtpmail-send-it) ;; 1) Be sure to use the LATEST version of el-mock.el. ;; 2) Enable debugger. M-x toggle-debug-on-error or (setq debug-on-error t) ;; 3) Use Lisp version instead of compiled one: (load "el-mock.el") ;; 4) Do it! ;; 5) If you got an error, please do not close *Backtrace* buffer. ;; 6) M-x mock-send-bug-report and M-x insert-buffer *Backtrace* ;; 7) Describe the bug using a precise recipe. ;; 8) Type C-c C-c to send. ;; # If you are a Japanese, please write in Japanese:-) ;;; Code: (eval-when-compile (require 'cl)) (require 'advice) (defvar -stubbed-functions nil) (defvar -mocked-functions nil) (defvar mock-verify-list nil) (defvar in-mocking nil) ;;;; stub setup/teardown (defun stub/setup (funcsym value) (mock-suppress-redefinition-message (lambda () (when (fboundp funcsym) (put funcsym 'mock-original-func (symbol-function funcsym))) (fset funcsym `(lambda (&rest x) ,value))))) (defun stub/teardown (funcsym) (mock-suppress-redefinition-message (lambda () (let ((func (get funcsym 'mock-original-func))) (if (not func) (fmakunbound funcsym) (fset funcsym func) ;; may be unadviced ))))) ;;;; mock setup/teardown (defun mock/setup (func-spec value times) (mock-suppress-redefinition-message (lambda () (let ((funcsym (car func-spec))) (when (fboundp funcsym) (put funcsym 'mock-original-func (symbol-function funcsym))) (put funcsym 'mock-call-count 0) (fset funcsym `(lambda (&rest actual-args) (incf (get ',funcsym 'mock-call-count)) (add-to-list 'mock-verify-list (list ',funcsym ',(cdr func-spec) actual-args ,times)) ,value)))))) (defun not-called/setup (funcsym) (mock-suppress-redefinition-message (lambda () (let () (when (fboundp funcsym) (put funcsym 'mock-original-func (symbol-function funcsym))) (fset funcsym `(lambda (&rest actual-args) (signal 'mock-error '(called)))))))) (defalias 'mock/teardown 'stub/teardown) ;;;; mock verify (put 'mock-error 'error-conditions '(mock-error error)) (put 'mock-error 'error-message "Mock error") (defun mock-verify () (loop for f in -mocked-functions when (equal 0 (get f 'mock-call-count)) do (signal 'mock-error (list 'not-called f))) (loop for args in mock-verify-list do (apply 'mock-verify-args args))) (defun mock-verify-args (funcsym expected-args actual-args expected-times) (loop for e in expected-args for a in actual-args do (unless (eq e '*) ; `*' is wildcard argument (unless (equal (eval e) a) (signal 'mock-error (list (cons funcsym expected-args) (cons funcsym actual-args)))))) (let ((actual-times (or (get funcsym 'mock-call-count) 0))) (and expected-times (/= expected-times actual-times) (signal 'mock-error (list (cons funcsym expected-args) :expected-times expected-times :actual-times actual-times))))) ;;;; stub/mock provider (defun mock-protect (body-fn) "The substance of `with-mock' macro. Prepare for mock/stub, call BODY-FN, and teardown mock/stub. For developer: When you adapt Emacs Lisp Mock to a testing framework, wrap test method around this function." (let (mock-verify-list -stubbed-functions -mocked-functions (in-mocking t) any-error) ;; (setplist 'mock-original-func nil) ;; (setplist 'mock-call-count nil) (unwind-protect (condition-case e (funcall body-fn) (error (setq any-error e))) (mapc #'stub/teardown -stubbed-functions) (unwind-protect (if any-error (signal (car any-error) (cdr any-error)) (mock-verify)) (mapc #'mock/teardown -mocked-functions))))) ;;;; message hack (defun mock-suppress-redefinition-message (func) "Erase \"ad-handle-definition: `%s' got redefined\" message." (funcall func)) (put 'mock-syntax-error 'error-conditions '(mock-syntax-error error)) (put 'mock-syntax-error 'error-message "Mock syntax error") ;;;; User interface (defmacro with-mock (&rest body) "Execute the forms in BODY. You can use `mock' and `stub' in BODY. The value returned is the value of the last form in BODY. After executing BODY, mocks and stubs are guaranteed to be released. Example: (with-mock (stub fooz => 2) (fooz 9999)) ; => 2 " `(mock-protect (lambda () ,@body))) (defalias 'with-stub 'with-mock) (defmacro stub (function &rest rest) "Create a stub for FUNCTION. Stubs are temporary functions which accept any arguments and return constant value. Stubs are removed outside `with-mock' (`with-stub' is an alias) and `mocklet'. Synopsis: * (stub FUNCTION) Create a FUNCTION stub which returns nil. * (stub FUNCTION => RETURN-VALUE) Create a FUNCTION stub which returns RETURN-VALUE. Example: (with-mock (stub foo) (stub bar => 1) (and (null (foo)) (= (bar 7) 1))) ; => t " (let ((value (cond ((plist-get rest '=>)) ((memq '=> rest) nil) ((null rest) nil) (t (signal 'mock-syntax-error '("Use `(stub FUNC)' or `(stub FUNC => RETURN-VALUE)'")))))) `(if (not in-mocking) (error "Do not use `stub' outside") (stub/setup ',function ',value) (push ',function -stubbed-functions)))) (defmacro mock (func-spec &rest rest) "Create a mock for function described by FUNC-SPEC. Mocks are temporary functions which accept specified arguments and return constant value. If mocked functions are not called or called by different arguments, an `mock-error' occurs. Mocks are removed outside `with-mock' and `mocklet'. Synopsis: * (mock (FUNCTION ARGS...)) Create a FUNCTION mock which returns nil. * (mock (FUNCTION ARGS...) => RETURN-VALUE) Create a FUNCTION mock which returns RETURN-VALUE. * (mock (FUNCTION ARGS...) :times N) FUNCTION must be called N times. * (mock (FUNCTION ARGS...) => RETURN-VALUE :times N) Create a FUNCTION mock which returns RETURN-VALUE. FUNCTION must be called N times. Wildcard: The `*' is a special symbol: it accepts any value for that argument position. Example: (with-mock (mock (f * 2) => 3) (mock (g 3)) (and (= (f 9 2) 3) (null (g 3)))) ; => t (with-mock (mock (g 3)) (g 7)) ; (mock-error (g 3) (g 7)) " (let* ((times (plist-get rest :times)) (value (cond ((plist-get rest '=>)) ((memq '=> rest) nil) ((null rest) nil) ((not times) (signal 'mock-syntax-error '("Use `(mock FUNC-SPEC)' or `(mock FUNC-SPEC => RETURN-VALUE)'")))))) `(if (not in-mocking) (error "Do not use `mock' outside") (mock/setup ',func-spec ',value ,times) (push ',(car func-spec) -mocked-functions)))) (defmacro not-called (function) "Create a not-called mock for FUNCTION. Not-called mocks are temporary functions which raises an error when called. If not-called functions are called, an `mock-error' occurs. Not-called mocks are removed outside `with-mock' and `mocklet'. Synopsis: * (not-called FUNCTION) Create a FUNCTION not-called mock. Example: (with-mock (not-called f) t) ; => t (with-mock (not-called g) (g 7)) ; => (mock-error called) " (let () `(if (not in-mocking) (error "Do not use `not-called' outside") (not-called/setup ',function) (push ',function -mocked-functions)))) (defun mock-parse-spec (spec) (cons 'progn (mapcar (lambda (args) (if (eq (cadr args) 'not-called) `(not-called ,(car args)) (cons (if (consp (car args)) 'mock 'stub) args))) spec))) (defun mocklet-function (spec body-func) (with-mock (eval (mock-parse-spec spec)) (funcall body-func))) (defmacro mocklet (speclist &rest body) "`let'-like interface of `with-mock', `mock', `not-called' and `stub'. Create mocks and stubs described by SPECLIST then execute the forms in BODY. SPECLIST is a list of mock/not-called/stub spec. The value returned is the value of the last form in BODY. After executing BODY, mocks and stubs are guaranteed to be released. Synopsis of spec: Spec is arguments of `mock', `not-called' or `stub'. * ((FUNCTION ARGS...)) : mock which returns nil * ((FUNCTION ARGS...) => RETURN-VALUE) ; mock which returns RETURN-VALUE * ((FUNCTION ARGS...) :times N ) ; mock to be called N times * ((FUNCTION ARGS...) => RETURN-VALUE :times N ) ; mock to be called N times * (FUNCTION) : stub which returns nil * (FUNCTION => RETURN-VALUE) ; stub which returns RETURN-VALUE * (FUNCTION not-called) ; not-called FUNCTION Example: (mocklet (((mock-nil 1)) ((mock-1 *) => 1) (stub-nil) (stub-2 => 2)) (and (null (mock-nil 1)) (= (mock-1 4) 1) (null (stub-nil 'any)) (= (stub-2) 2))) ; => t " `(mocklet-function ',speclist (lambda () ,@body))) (defalias 'stublet 'mocklet) (put 'with-mock 'lisp-indent-function 0) (put 'with-stub 'lisp-indent-function 0) (put 'mocklet 'lisp-indent-function 1) (put 'stublet 'lisp-indent-function 1) ;;;; Bug report (defvar mock-maintainer-mail-address (concat "rubiki" "tch@ru" "by-lang.org")) (defvar mock-bug-report-salutation "Describe bug below, using a precise recipe. When I executed M-x ... How to send a bug report: 1) Be sure to use the LATEST version of el-mock.el. 2) Enable debugger. M-x toggle-debug-on-error or (setq debug-on-error t) 3) Use Lisp version instead of compiled one: (load \"el-mock.el\") 4) If you got an error, please paste *Backtrace* buffer. 5) Type C-c C-c to send. # If you are a Japanese, please write in Japanese:-)") (defun mock-send-bug-report () (interactive) (reporter-submit-bug-report mock-maintainer-mail-address "el-mock.el" (apropos-internal "^mock-" 'boundp) nil nil mock-bug-report-salutation)) ;;;; unit test (dont-compile (when (fboundp 'expectations) (expectations (desc "stub setup/teardown") (expect 2 (stub/setup 'foo 2) (prog1 (foo 1 2 3) (stub/teardown 'foo))) (expect nil (stub/setup 'foox 2) (foox 1 2 3) (stub/teardown 'foox) (fboundp 'foox)) (desc "with-mock interface") (expect 9801 (with-mock 9801)) (desc "stub macro") (expect nil (with-mock (stub hogehoges) (hogehoges 75))) (expect 2 (with-mock (stub fooz => 2) (fooz 9999))) (expect nil (with-mock (stub fooz => 2) (fooz 3)) (fboundp 'fooz)) (expect nil (with-mock (stub hoge) ;omission of return value (hoge))) (expect 'hoge (with-mock (stub me => 'hoge) (me 1))) (expect 34 (with-mock (stub me => (+ 3 31)) (me 1))) ;; TODO defie mock-syntax-error / detect mock-syntax-error in expectations (desc "abused stub macro") (expect (error mock-syntax-error '("Use `(stub FUNC)' or `(stub FUNC => RETURN-VALUE)'")) (with-mock (stub fooz 7))) (expect (error-message "Do not use `stub' outside") (let (in-mocking) ; while executing `expect', `in-mocking' is t. (stub hahahaha))) (desc "mock macro") (expect 2 (with-mock (mock (foom 5) => 2) (foom 5))) (expect 3 (with-mock (mock (foo 5) => 2) (mock (bar 7) => 1) (+ (foo 5) (bar 7)))) (expect 3 (flet ((plus () (+ (foo 5) (bar 7)))) (with-mock (mock (foo 5) => 2) (mock (bar 7) => 1) (plus)))) (expect 1 (with-mock (mock (f * 2) => 1) (f 1 2))) (expect 1 (with-mock (mock (f * (1+ 1)) => (+ 0 1)) ;evaluated (f 1 2))) (expect nil (with-mock (mock (f 2)) ;omission of return value (f 2))) (expect 'hoge (with-mock (mock (me 1) => 'hoge) (me 1))) (expect 34 (with-mock (mock (me 1) => (+ 3 31)) (me 1))) (desc "unfulfilled mock") (expect (error mock-error '((foom 5) (foom 6))) (with-mock (mock (foom 5) => 2) (foom 6))) (expect (error mock-error '((bar 7) (bar 8))) (with-mock (mock (foo 5) => 2) (mock (bar 7) => 1) (+ (foo 5) (bar 8)))) (expect (error mock-error '(not-called foo)) (with-mock (mock (foo 5) => 2))) (expect (error mock-error '(not-called foo)) (with-mock (mock (vi 5) => 2) (mock (foo 5) => 2) (vi 5))) (expect (error mock-error '((f 2) (f 4))) (with-mock (mock (f 2)) ;omission of return value (f 4))) (expect (error-message "error-in-test1") (defun test1 () (error "error-in-test1")) (with-mock (mock (test2)) (test1))) (desc "abused mock macro") (expect (error mock-syntax-error '("Use `(mock FUNC-SPEC)' or `(mock FUNC-SPEC => RETURN-VALUE)'")) (with-mock (mock (fooz) 7))) (expect (error-message "Do not use `mock' outside") (let (in-mocking) ; while executing `expect', `in-mocking' is t. (mock (hahahaha)))) (desc "mock with stub") (expect 8 (with-mock (mock (f 1 2) => 3) (stub hoge => 5) (+ (f 1 2) (hoge 'a)))) (expect (error mock-error '((f 1 2) (f 3 4))) (with-mock (mock (f 1 2) => 3) (stub hoge => 5) (+ (f 3 4) (hoge 'a)))) (desc "with-stub is an alias of with-mock") (expect 'with-mock (symbol-function 'with-stub)) (desc "stublet is an alias of mocklet") (expect 'mocklet (symbol-function 'stublet)) (desc "mock-parse-spec") (expect '(progn (mock (f 1 2) => 3) (stub hoge => 5)) (mock-parse-spec '(((f 1 2) => 3) (hoge => 5)))) (expect '(progn (not-called g)) (mock-parse-spec '((g not-called)))) (desc "mocklet") (expect 8 (mocklet (((f 1 2) => 3) (hoge => 5)) (+ (f 1 2) (hoge 'a)))) (expect 2 (mocklet ((foo => 2)) (foo 1 2 3))) (expect 3 (defun defined-func (x) 3) (prog1 (mocklet ((defined-func => 3)) (defined-func 3)) (fmakunbound 'defined-func))) (expect nil (mocklet ((f)) ;omission of return value (f 91))) (expect nil (mocklet (((f 76))) ;omission of return value (f 76))) (expect 5 (mocklet ((a => 3) (b => 2)) 1 ;multiple exprs (+ (a 999) (b 7)))) (desc "stub for defined function") (expect "xxx" (defun blah (x) (* x 2)) (prog1 (let ((orig (symbol-function 'blah))) (mocklet ((blah => "xxx")) (blah "xx"))) (fmakunbound 'blah))) (expect t (defun blah (x) (* x 2)) (prog1 (let ((orig (symbol-function 'blah))) (mocklet ((blah => "xx")) (blah "xx")) (equal orig (symbol-function 'blah))) (fmakunbound 'blah))) (desc "stub for adviced function") (expect "xxx" (mock-suppress-redefinition-message ;silence redefinition warning (lambda () (defun fugaga (x) (* x 2)) (defadvice fugaga (around test activate) (setq ad-return-value (concat "[" ad-return-value "]"))) (prog1 (let ((orig (symbol-function 'fugaga))) (mocklet ((fugaga => "xxx")) (fugaga "aaaaa"))) (fmakunbound 'fugaga))))) (expect t (mock-suppress-redefinition-message (lambda () (defun fugaga (x) (* x 2)) (defadvice fugaga (around test activate) (setq ad-return-value (concat "[" ad-return-value "]"))) (prog1 (let ((orig (symbol-function 'fugaga))) (mocklet ((fugaga => "xx")) (fugaga "aaaaa")) (equal orig (symbol-function 'fugaga))) (fmakunbound 'fugaga))))) (desc "mock for adviced function") (expect "xx" (mock-suppress-redefinition-message (lambda () (defun fugaga (x) (* x 2)) (defadvice fugaga (around test activate) (setq ad-return-value (concat "[" ad-return-value "]"))) (prog1 (let ((orig (symbol-function 'fugaga))) (mocklet (((fugaga "aaaaa") => "xx")) (fugaga "aaaaa"))) (fmakunbound 'fugaga))))) (expect t (mock-suppress-redefinition-message (lambda () (defun fugaga (x) (* x 2)) (defadvice fugaga (around test activate) (setq ad-return-value (concat "[" ad-return-value "]"))) (prog1 (let ((orig (symbol-function 'fugaga))) (mocklet (((fugaga "aaaaa") => "xx")) (fugaga "aaaaa")) (equal orig (symbol-function 'fugaga))) (fmakunbound 'fugaga))))) (desc "not-called macro") (expect 'ok (with-mock (not-called foom) 'ok)) (desc "mocklet/notcalled") (expect 'ok (mocklet ((foom not-called)) 'ok)) (desc "unfulfilled not-called") (expect (error mock-error '(called)) (with-mock (not-called hoge) (hoge 1))) (desc "abused not-called macro") (expect (error-message "Do not use `not-called' outside") (let (in-mocking) ; while executing `expect', `in-mocking' is t. (not-called hahahaha))) (desc "not-called for adviced function") (expect "not-called" (mock-suppress-redefinition-message ;silence redefinition warning (lambda () (defun fugaga (x) (* x 2)) (defadvice fugaga (around test activate) (setq ad-return-value (concat "[" ad-return-value "]"))) (prog1 (let ((orig (symbol-function 'fugaga))) (mocklet ((fugaga not-called)) "not-called")) (fmakunbound 'fugaga))))) (expect t (mock-suppress-redefinition-message (lambda () (defun fugaga (x) (* x 2)) (defadvice fugaga (around test activate) (setq ad-return-value (concat "[" ad-return-value "]"))) (prog1 (let ((orig (symbol-function 'fugaga))) (mocklet ((fugaga not-called)) "not-called") (equal orig (symbol-function 'fugaga))) (fmakunbound 'fugaga))))) (desc ":times mock") (expect 'ok (with-mock (mock (foo 1) => 2 :times 2) (foo 1) (foo 1) 'ok)) (expect 'ok (with-mock (mock (foo *) => 2 :times 2) (foo 1) (foo 2) 'ok)) (expect 'ok (with-mock (mock (foo 1) :times 2) (foo 1) (foo 1) 'ok)) (expect 'ok (with-mock (mock (foo *) :times 2) (foo 1) (foo 2) 'ok)) ;; FIXME ;; (expect 'ok ;; (with-mock ;; (mock (foo 1) => 2 :times 2) ;; (foo 1) ;; (foo 1) ;; (foo 2) ;; 'ok)) (expect (error mock-error '((foo 1) :expected-times 2 :actual-times 1)) (with-mock (mock (foo 1) :times 2) (foo 1) 'ok)) (expect (error mock-error '((foo *) :expected-times 2 :actual-times 1)) (with-mock (mock (foo *) :times 2) (foo 1) 'ok)) (expect (error mock-error '((foo 1) (foo 2))) (with-mock (mock (foo 1) :times 2) (foo 2) 'ok)) (expect (error mock-error '(not-called foo)) (with-mock (mock (foo 1) :times 2) 'ok)) (expect (error mock-error '((foo 1) :expected-times 2 :actual-times 1)) (with-mock (mock (foo 1) => 2 :times 2) (foo 1) 'ok)) (expect (error mock-error '((foo *) :expected-times 2 :actual-times 1)) (with-mock (mock (foo *) => 2 :times 2) (foo 1) 'ok)) (expect (error mock-error '((foo 1) (foo 2))) (with-mock (mock (foo 1) => 2 :times 2) (foo 2) 'ok)) (expect (error mock-error '(not-called foo)) (with-mock (mock (foo 1) => 2 :times 2) 'ok)) ))) (provide 'el-mock) ;; How to save (DO NOT REMOVE!!) ;; (emacswiki-post "el-mock.el") ;;; el-mock.el ends here haskell-mode-13.14.2/tests/compat/ert.el000066400000000000000000003171351253441665600200160ustar00rootroot00000000000000;;; ert.el --- Emacs Lisp Regression Testing ;; Copyright (C) 2007-2008, 2010-2012 Free Software Foundation, Inc. ;; Author: Christian Ohler ;; Keywords: lisp, tools ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . ;;; Commentary: ;; ERT is a tool for automated testing in Emacs Lisp. Its main ;; features are facilities for defining and running test cases and ;; reporting the results as well as for debugging test failures ;; interactively. ;; ;; The main entry points are `ert-deftest', which is similar to ;; `defun' but defines a test, and `ert-run-tests-interactively', ;; which runs tests and offers an interactive interface for inspecting ;; results and debugging. There is also ;; `ert-run-tests-batch-and-exit' for non-interactive use. ;; ;; The body of `ert-deftest' forms resembles a function body, but the ;; additional operators `should', `should-not' and `should-error' are ;; available. `should' is similar to cl's `assert', but signals a ;; different error when its condition is violated that is caught and ;; processed by ERT. In addition, it analyzes its argument form and ;; records information that helps debugging (`assert' tries to do ;; something similar when its second argument SHOW-ARGS is true, but ;; `should' is more sophisticated). For information on `should-not' ;; and `should-error', see their docstrings. ;; ;; See ERT's info manual as well as the docstrings for more details. ;; To compile the manual, run `makeinfo ert.texinfo' in the ERT ;; directory, then C-u M-x info ert.info in Emacs to view it. ;; ;; To see some examples of tests written in ERT, see its self-tests in ;; ert-tests.el. Some of these are tricky due to the bootstrapping ;; problem of writing tests for a testing tool, others test simple ;; functions and are straightforward. ;;; Code: (eval-when-compile (require 'cl)) (require 'button) (require 'debug) (require 'easymenu) (require 'ewoc) (require 'find-func) (require 'help) ;;; UI customization options. (defgroup ert () "ERT, the Emacs Lisp regression testing tool." :prefix "ert-" :group 'lisp) (defface ert-test-result-expected '((((class color) (background light)) :background "green1") (((class color) (background dark)) :background "green3")) "Face used for expected results in the ERT results buffer." :group 'ert) (defface ert-test-result-unexpected '((((class color) (background light)) :background "red1") (((class color) (background dark)) :background "red3")) "Face used for unexpected results in the ERT results buffer." :group 'ert) ;;; Copies/reimplementations of cl functions. (defun ert--cl-do-remf (plist tag) "Copy of `cl-do-remf'. Modify PLIST by removing TAG." (let ((p (cdr plist))) (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p)))) (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) (defun ert--remprop (sym tag) "Copy of `cl-remprop'. Modify SYM's plist by removing TAG." (let ((plist (symbol-plist sym))) (if (and plist (eq tag (car plist))) (progn (setplist sym (cdr (cdr plist))) t) (ert--cl-do-remf plist tag)))) (defun ert--remove-if-not (ert-pred ert-list) "A reimplementation of `remove-if-not'. ERT-PRED is a predicate, ERT-LIST is the input list." (loop for ert-x in ert-list if (funcall ert-pred ert-x) collect ert-x)) (defun ert--intersection (a b) "A reimplementation of `intersection'. Intersect the sets A and B. Elements are compared using `eql'." (loop for x in a if (memql x b) collect x)) (defun ert--set-difference (a b) "A reimplementation of `set-difference'. Subtract the set B from the set A. Elements are compared using `eql'." (loop for x in a unless (memql x b) collect x)) (defun ert--set-difference-eq (a b) "A reimplementation of `set-difference'. Subtract the set B from the set A. Elements are compared using `eq'." (loop for x in a unless (memq x b) collect x)) (defun ert--union (a b) "A reimplementation of `union'. Compute the union of the sets A and B. Elements are compared using `eql'." (append a (ert--set-difference b a))) (eval-and-compile (defvar ert--gensym-counter 0)) (eval-and-compile (defun ert--gensym (&optional prefix) "Only allows string PREFIX, not compatible with CL." (unless prefix (setq prefix "G")) (make-symbol (format "%s%s" prefix (prog1 ert--gensym-counter (incf ert--gensym-counter)))))) (defun ert--coerce-to-vector (x) "Coerce X to a vector." (when (char-table-p x) (error "Not supported")) (if (vectorp x) x (vconcat x))) (defun* ert--remove* (x list &key key test) "Does not support all the keywords of remove*." (unless key (setq key #'identity)) (unless test (setq test #'eql)) (loop for y in list unless (funcall test x (funcall key y)) collect y)) (defun ert--string-position (c s) "Return the position of the first occurrence of C in S, or nil if none." (loop for i from 0 for x across s when (eql x c) return i)) (defun ert--mismatch (a b) "Return index of first element that differs between A and B. Like `mismatch'. Uses `equal' for comparison." (cond ((or (listp a) (listp b)) (ert--mismatch (ert--coerce-to-vector a) (ert--coerce-to-vector b))) ((> (length a) (length b)) (ert--mismatch b a)) (t (let ((la (length a)) (lb (length b))) (assert (arrayp a) t) (assert (arrayp b) t) (assert (<= la lb) t) (loop for i below la when (not (equal (aref a i) (aref b i))) return i finally (return (if (/= la lb) la (assert (equal a b) t) nil))))))) (defun ert--subseq (seq start &optional end) "Return a subsequence of SEQ from START to END." (when (char-table-p seq) (error "Not supported")) (let ((vector (substring (ert--coerce-to-vector seq) start end))) (etypecase seq (vector vector) (string (concat vector)) (list (append vector nil)) (bool-vector (loop with result = (make-bool-vector (length vector) nil) for i below (length vector) do (setf (aref result i) (aref vector i)) finally (return result))) (char-table (assert nil))))) (defun ert-equal-including-properties (a b) "Return t if A and B have similar structure and contents. This is like `equal-including-properties' except that it compares the property values of text properties structurally (by recursing) rather than with `eq'. Perhaps this is what `equal-including-properties' should do in the first place; see Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'." ;; This implementation is inefficient. Rather than making it ;; efficient, let's hope bug 6581 gets fixed so that we can delete ;; it altogether. (not (ert--explain-equal-including-properties a b))) ;;; Defining and locating tests. ;; The data structure that represents a test case. (defstruct ert-test (name nil) (documentation nil) (body (assert nil)) (most-recent-result nil) (expected-result-type ':passed) (tags '())) (defun ert-test-boundp (symbol) "Return non-nil if SYMBOL names a test." (and (get symbol 'ert--test) t)) (defun ert-get-test (symbol) "If SYMBOL names a test, return that. Signal an error otherwise." (unless (ert-test-boundp symbol) (error "No test named `%S'" symbol)) (get symbol 'ert--test)) (defun ert-set-test (symbol definition) "Make SYMBOL name the test DEFINITION, and return DEFINITION." (when (eq symbol 'nil) ;; We disallow nil since `ert-test-at-point' and related functions ;; want to return a test name, but also need an out-of-band value ;; on failure. Nil is the most natural out-of-band value; using 0 ;; or "" or signaling an error would be too awkward. ;; ;; Note that nil is still a valid value for the `name' slot in ;; ert-test objects. It designates an anonymous test. (error "Attempt to define a test named nil")) (put symbol 'ert--test definition) definition) (defun ert-make-test-unbound (symbol) "Make SYMBOL name no test. Return SYMBOL." (ert--remprop symbol 'ert--test) symbol) (defun ert--parse-keys-and-body (keys-and-body) "Split KEYS-AND-BODY into keyword-and-value pairs and the remaining body. KEYS-AND-BODY should have the form of a property list, with the exception that only keywords are permitted as keys and that the tail -- the body -- is a list of forms that does not start with a keyword. Returns a two-element list containing the keys-and-values plist and the body." (let ((extracted-key-accu '()) (remaining keys-and-body)) (while (and (consp remaining) (keywordp (first remaining))) (let ((keyword (pop remaining))) (unless (consp remaining) (error "Value expected after keyword %S in %S" keyword keys-and-body)) (when (assoc keyword extracted-key-accu) (warn "Keyword %S appears more than once in %S" keyword keys-and-body)) (push (cons keyword (pop remaining)) extracted-key-accu))) (setq extracted-key-accu (nreverse extracted-key-accu)) (list (loop for (key . value) in extracted-key-accu collect key collect value) remaining))) ;;;###autoload (defmacro* ert-deftest (name () &body docstring-keys-and-body) "Define NAME (a symbol) as a test. BODY is evaluated as a `progn' when the test is run. It should signal a condition on failure or just return if the test passes. `should', `should-not' and `should-error' are useful for assertions in BODY. Use `ert' to run tests interactively. Tests that are expected to fail can be marked as such using :expected-result. See `ert-test-result-type-p' for a description of valid values for RESULT-TYPE. \(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] \ \[:tags '(TAG...)] BODY...)" (declare (debug (&define :name test name sexp [&optional stringp] [&rest keywordp sexp] def-body)) (doc-string 3) (indent 2)) (let ((documentation nil) (documentation-supplied-p nil)) (when (stringp (first docstring-keys-and-body)) (setq documentation (pop docstring-keys-and-body) documentation-supplied-p t)) (destructuring-bind ((&key (expected-result nil expected-result-supplied-p) (tags nil tags-supplied-p)) body) (ert--parse-keys-and-body docstring-keys-and-body) `(progn (ert-set-test ',name (make-ert-test :name ',name ,@(when documentation-supplied-p `(:documentation ,documentation)) ,@(when expected-result-supplied-p `(:expected-result-type ,expected-result)) ,@(when tags-supplied-p `(:tags ,tags)) :body (lambda () ,@body))) ;; This hack allows `symbol-file' to associate `ert-deftest' ;; forms with files, and therefore enables `find-function' to ;; work with tests. However, it leads to warnings in ;; `unload-feature', which doesn't know how to undefine tests ;; and has no mechanism for extension. (push '(ert-deftest . ,name) current-load-list) ',name)))) ;; We use these `put' forms in addition to the (declare (indent)) in ;; the defmacro form since the `declare' alone does not lead to ;; correct indentation before the .el/.elc file is loaded. ;; Autoloading these `put' forms solves this. ;;;###autoload (progn ;; TODO(ohler): Figure out what these mean and make sure they are correct. (put 'ert-deftest 'lisp-indent-function 2) (put 'ert-info 'lisp-indent-function 1)) (defvar ert--find-test-regexp (concat "^\\s-*(ert-deftest" find-function-space-re "%s\\(\\s-\\|$\\)") "The regexp the `find-function' mechanisms use for finding test definitions.") (put 'ert-test-failed 'error-conditions '(error ert-test-failed)) (put 'ert-test-failed 'error-message "Test failed") (defun ert-pass () "Terminate the current test and mark it passed. Does not return." (throw 'ert--pass nil)) (defun ert-fail (data) "Terminate the current test and mark it failed. Does not return. DATA is displayed to the user and should state the reason of the failure." (signal 'ert-test-failed (list data))) ;;; The `should' macros. (defvar ert--should-execution-observer nil) (defun ert--signal-should-execution (form-description) "Tell the current `should' form observer (if any) about FORM-DESCRIPTION." (when ert--should-execution-observer (funcall ert--should-execution-observer form-description))) (defun ert--special-operator-p (thing) "Return non-nil if THING is a symbol naming a special operator." (and (symbolp thing) (let ((definition (indirect-function thing t))) (and (subrp definition) (eql (cdr (subr-arity definition)) 'unevalled))))) (defun ert--expand-should-1 (whole form inner-expander) "Helper function for the `should' macro and its variants." (let ((form (macroexpand form (cond ((boundp 'macroexpand-all-environment) macroexpand-all-environment) ((boundp 'cl-macro-environment) cl-macro-environment))))) (cond ((or (atom form) (ert--special-operator-p (car form))) (let ((value (ert--gensym "value-"))) `(let ((,value (ert--gensym "ert-form-evaluation-aborted-"))) ,(funcall inner-expander `(setq ,value ,form) `(list ',whole :form ',form :value ,value) value) ,value))) (t (let ((fn-name (car form)) (arg-forms (cdr form))) (assert (or (symbolp fn-name) (and (consp fn-name) (eql (car fn-name) 'lambda) (listp (cdr fn-name))))) (let ((fn (ert--gensym "fn-")) (args (ert--gensym "args-")) (value (ert--gensym "value-")) (default-value (ert--gensym "ert-form-evaluation-aborted-"))) `(let ((,fn (function ,fn-name)) (,args (list ,@arg-forms))) (let ((,value ',default-value)) ,(funcall inner-expander `(setq ,value (apply ,fn ,args)) `(nconc (list ',whole) (list :form `(,,fn ,@,args)) (unless (eql ,value ',default-value) (list :value ,value)) (let ((-explainer- (and (symbolp ',fn-name) (get ',fn-name 'ert-explainer)))) (when -explainer- (list :explanation (apply -explainer- ,args))))) value) ,value)))))))) (defun ert--expand-should (whole form inner-expander) "Helper function for the `should' macro and its variants. Analyzes FORM and returns an expression that has the same semantics under evaluation but records additional debugging information. INNER-EXPANDER should be a function and is called with two arguments: INNER-FORM and FORM-DESCRIPTION-FORM, where INNER-FORM is an expression equivalent to FORM, and FORM-DESCRIPTION-FORM is an expression that returns a description of FORM. INNER-EXPANDER should return code that calls INNER-FORM and performs the checks and error signaling specific to the particular variant of `should'. The code that INNER-EXPANDER returns must not call FORM-DESCRIPTION-FORM before it has called INNER-FORM." (lexical-let ((inner-expander inner-expander)) (ert--expand-should-1 whole form (lambda (inner-form form-description-form value-var) (let ((form-description (ert--gensym "form-description-"))) `(let (,form-description) ,(funcall inner-expander `(unwind-protect ,inner-form (setq ,form-description ,form-description-form) (ert--signal-should-execution ,form-description)) `,form-description value-var))))))) (defmacro* should (form) "Evaluate FORM. If it returns nil, abort the current test as failed. Returns the value of FORM." (ert--expand-should `(should ,form) form (lambda (inner-form form-description-form value-var) `(unless ,inner-form (ert-fail ,form-description-form))))) (defmacro* should-not (form) "Evaluate FORM. If it returns non-nil, abort the current test as failed. Returns nil." (ert--expand-should `(should-not ,form) form (lambda (inner-form form-description-form value-var) `(unless (not ,inner-form) (ert-fail ,form-description-form))))) (defun ert--should-error-handle-error (form-description-fn condition type exclude-subtypes) "Helper function for `should-error'. Determines whether CONDITION matches TYPE and EXCLUDE-SUBTYPES, and aborts the current test as failed if it doesn't." (let ((signaled-conditions (get (car condition) 'error-conditions)) (handled-conditions (etypecase type (list type) (symbol (list type))))) (assert signaled-conditions) (unless (ert--intersection signaled-conditions handled-conditions) (ert-fail (append (funcall form-description-fn) (list :condition condition :fail-reason (concat "the error signaled did not" " have the expected type"))))) (when exclude-subtypes (unless (member (car condition) handled-conditions) (ert-fail (append (funcall form-description-fn) (list :condition condition :fail-reason (concat "the error signaled was a subtype" " of the expected type")))))))) ;; FIXME: The expansion will evaluate the keyword args (if any) in ;; nonstandard order. (defmacro* should-error (form &rest keys &key type exclude-subtypes) "Evaluate FORM and check that it signals an error. The error signaled needs to match TYPE. TYPE should be a list of condition names. (It can also be a non-nil symbol, which is equivalent to a singleton list containing that symbol.) If EXCLUDE-SUBTYPES is nil, the error matches TYPE if one of its condition names is an element of TYPE. If EXCLUDE-SUBTYPES is non-nil, the error matches TYPE if it is an element of TYPE. If the error matches, returns (ERROR-SYMBOL . DATA) from the error. If not, or if no error was signaled, abort the test as failed." (unless type (setq type ''error)) (ert--expand-should `(should-error ,form ,@keys) form (lambda (inner-form form-description-form value-var) (let ((errorp (ert--gensym "errorp")) (form-description-fn (ert--gensym "form-description-fn-"))) `(let ((,errorp nil) (,form-description-fn (lambda () ,form-description-form))) (condition-case -condition- ,inner-form ;; We can't use ,type here because we want to evaluate it. (error (setq ,errorp t) (ert--should-error-handle-error ,form-description-fn -condition- ,type ,exclude-subtypes) (setq ,value-var -condition-))) (unless ,errorp (ert-fail (append (funcall ,form-description-fn) (list :fail-reason "did not signal an error"))))))))) ;;; Explanation of `should' failures. ;; TODO(ohler): Rework explanations so that they are displayed in a ;; similar way to `ert-info' messages; in particular, allow text ;; buttons in explanations that give more detail or open an ediff ;; buffer. Perhaps explanations should be reported through `ert-info' ;; rather than as part of the condition. (defun ert--proper-list-p (x) "Return non-nil if X is a proper list, nil otherwise." (loop for firstp = t then nil for fast = x then (cddr fast) for slow = x then (cdr slow) do (when (null fast) (return t)) (when (not (consp fast)) (return nil)) (when (null (cdr fast)) (return t)) (when (not (consp (cdr fast))) (return nil)) (when (and (not firstp) (eq fast slow)) (return nil)))) (defun ert--explain-format-atom (x) "Format the atom X for `ert--explain-equal'." (typecase x (fixnum (list x (format "#x%x" x) (format "?%c" x))) (t x))) (defun ert--explain-equal-rec (a b) "Return a programmer-readable explanation of why A and B are not `equal'. Returns nil if they are." (if (not (equal (type-of a) (type-of b))) `(different-types ,a ,b) (etypecase a (cons (let ((a-proper-p (ert--proper-list-p a)) (b-proper-p (ert--proper-list-p b))) (if (not (eql (not a-proper-p) (not b-proper-p))) `(one-list-proper-one-improper ,a ,b) (if a-proper-p (if (not (equal (length a) (length b))) `(proper-lists-of-different-length ,(length a) ,(length b) ,a ,b first-mismatch-at ,(ert--mismatch a b)) (loop for i from 0 for ai in a for bi in b for xi = (ert--explain-equal-rec ai bi) do (when xi (return `(list-elt ,i ,xi))) finally (assert (equal a b) t))) (let ((car-x (ert--explain-equal-rec (car a) (car b)))) (if car-x `(car ,car-x) (let ((cdr-x (ert--explain-equal-rec (cdr a) (cdr b)))) (if cdr-x `(cdr ,cdr-x) (assert (equal a b) t) nil)))))))) (array (if (not (equal (length a) (length b))) `(arrays-of-different-length ,(length a) ,(length b) ,a ,b ,@(unless (char-table-p a) `(first-mismatch-at ,(ert--mismatch a b)))) (loop for i from 0 for ai across a for bi across b for xi = (ert--explain-equal-rec ai bi) do (when xi (return `(array-elt ,i ,xi))) finally (assert (equal a b) t)))) (atom (if (not (equal a b)) (if (and (symbolp a) (symbolp b) (string= a b)) `(different-symbols-with-the-same-name ,a ,b) `(different-atoms ,(ert--explain-format-atom a) ,(ert--explain-format-atom b))) nil))))) (defun ert--explain-equal (a b) "Explainer function for `equal'." ;; Do a quick comparison in C to avoid running our expensive ;; comparison when possible. (if (equal a b) nil (ert--explain-equal-rec a b))) (put 'equal 'ert-explainer 'ert--explain-equal) (defun ert--significant-plist-keys (plist) "Return the keys of PLIST that have non-null values, in order." (assert (zerop (mod (length plist) 2)) t) (loop for (key value . rest) on plist by #'cddr unless (or (null value) (memq key accu)) collect key into accu finally (return accu))) (defun ert--plist-difference-explanation (a b) "Return a programmer-readable explanation of why A and B are different plists. Returns nil if they are equivalent, i.e., have the same value for each key, where absent values are treated as nil. The order of key/value pairs in each list does not matter." (assert (zerop (mod (length a) 2)) t) (assert (zerop (mod (length b) 2)) t) ;; Normalizing the plists would be another way to do this but it ;; requires a total ordering on all lisp objects (since any object ;; is valid as a text property key). Perhaps defining such an ;; ordering is useful in other contexts, too, but it's a lot of ;; work, so let's punt on it for now. (let* ((keys-a (ert--significant-plist-keys a)) (keys-b (ert--significant-plist-keys b)) (keys-in-a-not-in-b (ert--set-difference-eq keys-a keys-b)) (keys-in-b-not-in-a (ert--set-difference-eq keys-b keys-a))) (flet ((explain-with-key (key) (let ((value-a (plist-get a key)) (value-b (plist-get b key))) (assert (not (equal value-a value-b)) t) `(different-properties-for-key ,key ,(ert--explain-equal-including-properties value-a value-b))))) (cond (keys-in-a-not-in-b (explain-with-key (first keys-in-a-not-in-b))) (keys-in-b-not-in-a (explain-with-key (first keys-in-b-not-in-a))) (t (loop for key in keys-a when (not (equal (plist-get a key) (plist-get b key))) return (explain-with-key key))))))) (defun ert--abbreviate-string (s len suffixp) "Shorten string S to at most LEN chars. If SUFFIXP is non-nil, returns a suffix of S, otherwise a prefix." (let ((n (length s))) (cond ((< n len) s) (suffixp (substring s (- n len))) (t (substring s 0 len))))) ;; TODO(ohler): Once bug 6581 is fixed, rename this to ;; `ert--explain-equal-including-properties-rec' and add a fast-path ;; wrapper like `ert--explain-equal'. (defun ert--explain-equal-including-properties (a b) "Explainer function for `ert-equal-including-properties'. Returns a programmer-readable explanation of why A and B are not `ert-equal-including-properties', or nil if they are." (if (not (equal a b)) (ert--explain-equal a b) (assert (stringp a) t) (assert (stringp b) t) (assert (eql (length a) (length b)) t) (loop for i from 0 to (length a) for props-a = (text-properties-at i a) for props-b = (text-properties-at i b) for difference = (ert--plist-difference-explanation props-a props-b) do (when difference (return `(char ,i ,(substring-no-properties a i (1+ i)) ,difference context-before ,(ert--abbreviate-string (substring-no-properties a 0 i) 10 t) context-after ,(ert--abbreviate-string (substring-no-properties a (1+ i)) 10 nil)))) ;; TODO(ohler): Get `equal-including-properties' fixed in ;; Emacs, delete `ert-equal-including-properties', and ;; re-enable this assertion. ;;finally (assert (equal-including-properties a b) t) ))) (put 'ert-equal-including-properties 'ert-explainer 'ert--explain-equal-including-properties) ;;; Implementation of `ert-info'. ;; TODO(ohler): The name `info' clashes with ;; `ert--test-execution-info'. One or both should be renamed. (defvar ert--infos '() "The stack of `ert-info' infos that currently apply. Bound dynamically. This is a list of (PREFIX . MESSAGE) pairs.") (defmacro* ert-info ((message-form &key ((:prefix prefix-form) "Info: ")) &body body) "Evaluate MESSAGE-FORM and BODY, and report the message if BODY fails. To be used within ERT tests. MESSAGE-FORM should evaluate to a string that will be displayed together with the test result if the test fails. PREFIX-FORM should evaluate to a string as well and is displayed in front of the value of MESSAGE-FORM." (declare (debug ((form &rest [sexp form]) body)) (indent 1)) `(let ((ert--infos (cons (cons ,prefix-form ,message-form) ert--infos))) ,@body)) ;;; Facilities for running a single test. (defvar ert-debug-on-error nil "Non-nil means enter debugger when a test fails or terminates with an error.") ;; The data structures that represent the result of running a test. (defstruct ert-test-result (messages nil) (should-forms nil) ) (defstruct (ert-test-passed (:include ert-test-result))) (defstruct (ert-test-result-with-condition (:include ert-test-result)) (condition (assert nil)) (backtrace (assert nil)) (infos (assert nil))) (defstruct (ert-test-quit (:include ert-test-result-with-condition))) (defstruct (ert-test-failed (:include ert-test-result-with-condition))) (defstruct (ert-test-aborted-with-non-local-exit (:include ert-test-result))) (defun ert--record-backtrace () "Record the current backtrace (as a list) and return it." ;; Since the backtrace is stored in the result object, result ;; objects must only be printed with appropriate limits ;; (`print-level' and `print-length') in place. For interactive ;; use, the cost of ensuring this possibly outweighs the advantage ;; of storing the backtrace for ;; `ert-results-pop-to-backtrace-for-test-at-point' given that we ;; already have `ert-results-rerun-test-debugging-errors-at-point'. ;; For batch use, however, printing the backtrace may be useful. (loop ;; 6 is the number of frames our own debugger adds (when ;; compiled; more when interpreted). FIXME: Need to describe a ;; procedure for determining this constant. for i from 6 for frame = (backtrace-frame i) while frame collect frame)) (defun ert--print-backtrace (backtrace) "Format the backtrace BACKTRACE to the current buffer." ;; This is essentially a reimplementation of Fbacktrace ;; (src/eval.c), but for a saved backtrace, not the current one. (let ((print-escape-newlines t) (print-level 8) (print-length 50)) (dolist (frame backtrace) (ecase (first frame) ((nil) ;; Special operator. (destructuring-bind (special-operator &rest arg-forms) (cdr frame) (insert (format " %S\n" (list* special-operator arg-forms))))) ((t) ;; Function call. (destructuring-bind (fn &rest args) (cdr frame) (insert (format " %S(" fn)) (loop for firstp = t then nil for arg in args do (unless firstp (insert " ")) (insert (format "%S" arg))) (insert ")\n"))))))) ;; A container for the state of the execution of a single test and ;; environment data needed during its execution. (defstruct ert--test-execution-info (test (assert nil)) (result (assert nil)) ;; A thunk that may be called when RESULT has been set to its final ;; value and test execution should be terminated. Should not ;; return. (exit-continuation (assert nil)) ;; The binding of `debugger' outside of the execution of the test. next-debugger ;; The binding of `ert-debug-on-error' that is in effect for the ;; execution of the current test. We store it to avoid being ;; affected by any new bindings the test itself may establish. (I ;; don't remember whether this feature is important.) ert-debug-on-error) (defun ert--run-test-debugger (info debugger-args) "During a test run, `debugger' is bound to a closure that calls this function. This function records failures and errors and either terminates the test silently or calls the interactive debugger, as appropriate. INFO is the ert--test-execution-info corresponding to this test run. DEBUGGER-ARGS are the arguments to `debugger'." (destructuring-bind (first-debugger-arg &rest more-debugger-args) debugger-args (ecase first-debugger-arg ((lambda debug t exit nil) (apply (ert--test-execution-info-next-debugger info) debugger-args)) (error (let* ((condition (first more-debugger-args)) (type (case (car condition) ((quit) 'quit) (otherwise 'failed))) (backtrace (ert--record-backtrace)) (infos (reverse ert--infos))) (setf (ert--test-execution-info-result info) (ecase type (quit (make-ert-test-quit :condition condition :backtrace backtrace :infos infos)) (failed (make-ert-test-failed :condition condition :backtrace backtrace :infos infos)))) ;; Work around Emacs's heuristic (in eval.c) for detecting ;; errors in the debugger. (incf num-nonmacro-input-events) ;; FIXME: We should probably implement more fine-grained ;; control a la non-t `debug-on-error' here. (cond ((ert--test-execution-info-ert-debug-on-error info) (apply (ert--test-execution-info-next-debugger info) debugger-args)) (t)) (funcall (ert--test-execution-info-exit-continuation info))))))) (defun ert--run-test-internal (ert-test-execution-info) "Low-level function to run a test according to ERT-TEST-EXECUTION-INFO. This mainly sets up debugger-related bindings." (lexical-let ((info ert-test-execution-info)) (setf (ert--test-execution-info-next-debugger info) debugger (ert--test-execution-info-ert-debug-on-error info) ert-debug-on-error) (catch 'ert--pass ;; For now, each test gets its own temp buffer and its own ;; window excursion, just to be safe. If this turns out to be ;; too expensive, we can remove it. (with-temp-buffer (save-window-excursion (let ((debugger (lambda (&rest debugger-args) (ert--run-test-debugger info debugger-args))) (debug-on-error t) (debug-on-quit t) ;; FIXME: Do we need to store the old binding of this ;; and consider it in `ert--run-test-debugger'? (debug-ignored-errors nil) (ert--infos '())) (funcall (ert-test-body (ert--test-execution-info-test info)))))) (ert-pass)) (setf (ert--test-execution-info-result info) (make-ert-test-passed))) nil) (defun ert--force-message-log-buffer-truncation () "Immediately truncate *Messages* buffer according to `message-log-max'. This can be useful after reducing the value of `message-log-max'." (with-current-buffer (get-buffer-create "*Messages*") ;; This is a reimplementation of this part of message_dolog() in xdisp.c: ;; if (NATNUMP (Vmessage_log_max)) ;; { ;; scan_newline (Z, Z_BYTE, BEG, BEG_BYTE, ;; -XFASTINT (Vmessage_log_max) - 1, 0); ;; del_range_both (BEG, BEG_BYTE, PT, PT_BYTE, 0); ;; } (when (and (integerp message-log-max) (>= message-log-max 0)) (let ((begin (point-min)) (end (save-excursion (goto-char (point-max)) (forward-line (- message-log-max)) (point)))) (delete-region begin end))))) (defvar ert--running-tests nil "List of tests that are currently in execution. This list is empty while no test is running, has one element while a test is running, two elements while a test run from inside a test is running, etc. The list is in order of nesting, innermost test first. The elements are of type `ert-test'.") (defun ert-run-test (ert-test) "Run ERT-TEST. Returns the result and stores it in ERT-TEST's `most-recent-result' slot." (setf (ert-test-most-recent-result ert-test) nil) (block error (lexical-let ((begin-marker (with-current-buffer (get-buffer-create "*Messages*") (set-marker (make-marker) (point-max))))) (unwind-protect (lexical-let ((info (make-ert--test-execution-info :test ert-test :result (make-ert-test-aborted-with-non-local-exit) :exit-continuation (lambda () (return-from error nil)))) (should-form-accu (list))) (unwind-protect (let ((ert--should-execution-observer (lambda (form-description) (push form-description should-form-accu))) (message-log-max t) (ert--running-tests (cons ert-test ert--running-tests))) (ert--run-test-internal info)) (let ((result (ert--test-execution-info-result info))) (setf (ert-test-result-messages result) (with-current-buffer (get-buffer-create "*Messages*") (buffer-substring begin-marker (point-max)))) (ert--force-message-log-buffer-truncation) (setq should-form-accu (nreverse should-form-accu)) (setf (ert-test-result-should-forms result) should-form-accu) (setf (ert-test-most-recent-result ert-test) result)))) (set-marker begin-marker nil)))) (ert-test-most-recent-result ert-test)) (defun ert-running-test () "Return the top-level test currently executing." (car (last ert--running-tests))) ;;; Test selectors. (defun ert-test-result-type-p (result result-type) "Return non-nil if RESULT matches type RESULT-TYPE. Valid result types: nil -- Never matches. t -- Always matches. :failed, :passed -- Matches corresponding results. \(and TYPES...\) -- Matches if all TYPES match. \(or TYPES...\) -- Matches if some TYPES match. \(not TYPE\) -- Matches if TYPE does not match. \(satisfies PREDICATE\) -- Matches if PREDICATE returns true when called with RESULT." ;; It would be easy to add `member' and `eql' types etc., but I ;; haven't bothered yet. (etypecase result-type ((member nil) nil) ((member t) t) ((member :failed) (ert-test-failed-p result)) ((member :passed) (ert-test-passed-p result)) (cons (destructuring-bind (operator &rest operands) result-type (ecase operator (and (case (length operands) (0 t) (t (and (ert-test-result-type-p result (first operands)) (ert-test-result-type-p result `(and ,@(rest operands))))))) (or (case (length operands) (0 nil) (t (or (ert-test-result-type-p result (first operands)) (ert-test-result-type-p result `(or ,@(rest operands))))))) (not (assert (eql (length operands) 1)) (not (ert-test-result-type-p result (first operands)))) (satisfies (assert (eql (length operands) 1)) (funcall (first operands) result))))))) (defun ert-test-result-expected-p (test result) "Return non-nil if TEST's expected result type matches RESULT." (ert-test-result-type-p result (ert-test-expected-result-type test))) (defun ert-select-tests (selector universe) "Return a list of tests that match SELECTOR. UNIVERSE specifies the set of tests to select from; it should be a list of tests, or t, which refers to all tests named by symbols in `obarray'. Valid SELECTORs: nil -- Selects the empty set. t -- Selects UNIVERSE. :new -- Selects all tests that have not been run yet. :failed, :passed -- Select tests according to their most recent result. :expected, :unexpected -- Select tests according to their most recent result. a string -- A regular expression selecting all tests with matching names. a test -- (i.e., an object of the ert-test data-type) Selects that test. a symbol -- Selects the test that the symbol names, errors if none. \(member TESTS...) -- Selects the elements of TESTS, a list of tests or symbols naming tests. \(eql TEST\) -- Selects TEST, a test or a symbol naming a test. \(and SELECTORS...) -- Selects the tests that match all SELECTORS. \(or SELECTORS...) -- Selects the tests that match any of the SELECTORS. \(not SELECTOR) -- Selects all tests that do not match SELECTOR. \(tag TAG) -- Selects all tests that have TAG on their tags list. A tag is an arbitrary label you can apply when you define a test. \(satisfies PREDICATE) -- Selects all tests that satisfy PREDICATE. PREDICATE is a function that takes an ert-test object as argument, and returns non-nil if it is selected. Only selectors that require a superset of tests, such as (satisfies ...), strings, :new, etc. make use of UNIVERSE. Selectors that do not, such as (member ...), just return the set implied by them without checking whether it is really contained in UNIVERSE." ;; This code needs to match the etypecase in ;; `ert-insert-human-readable-selector'. (etypecase selector ((member nil) nil) ((member t) (etypecase universe (list universe) ((member t) (ert-select-tests "" universe)))) ((member :new) (ert-select-tests `(satisfies ,(lambda (test) (null (ert-test-most-recent-result test)))) universe)) ((member :failed) (ert-select-tests `(satisfies ,(lambda (test) (ert-test-result-type-p (ert-test-most-recent-result test) ':failed))) universe)) ((member :passed) (ert-select-tests `(satisfies ,(lambda (test) (ert-test-result-type-p (ert-test-most-recent-result test) ':passed))) universe)) ((member :expected) (ert-select-tests `(satisfies ,(lambda (test) (ert-test-result-expected-p test (ert-test-most-recent-result test)))) universe)) ((member :unexpected) (ert-select-tests `(not :expected) universe)) (string (etypecase universe ((member t) (mapcar #'ert-get-test (apropos-internal selector #'ert-test-boundp))) (list (ert--remove-if-not (lambda (test) (and (ert-test-name test) (string-match selector (ert-test-name test)))) universe)))) (ert-test (list selector)) (symbol (assert (ert-test-boundp selector)) (list (ert-get-test selector))) (cons (destructuring-bind (operator &rest operands) selector (ecase operator (member (mapcar (lambda (purported-test) (etypecase purported-test (symbol (assert (ert-test-boundp purported-test)) (ert-get-test purported-test)) (ert-test purported-test))) operands)) (eql (assert (eql (length operands) 1)) (ert-select-tests `(member ,@operands) universe)) (and ;; Do these definitions of AND, NOT and OR satisfy de ;; Morgan's laws? Should they? (case (length operands) (0 (ert-select-tests 't universe)) (t (ert-select-tests `(and ,@(rest operands)) (ert-select-tests (first operands) universe))))) (not (assert (eql (length operands) 1)) (let ((all-tests (ert-select-tests 't universe))) (ert--set-difference all-tests (ert-select-tests (first operands) all-tests)))) (or (case (length operands) (0 (ert-select-tests 'nil universe)) (t (ert--union (ert-select-tests (first operands) universe) (ert-select-tests `(or ,@(rest operands)) universe))))) (tag (assert (eql (length operands) 1)) (let ((tag (first operands))) (ert-select-tests `(satisfies ,(lambda (test) (member tag (ert-test-tags test)))) universe))) (satisfies (assert (eql (length operands) 1)) (ert--remove-if-not (first operands) (ert-select-tests 't universe)))))))) (defun ert--insert-human-readable-selector (selector) "Insert a human-readable presentation of SELECTOR into the current buffer." ;; This is needed to avoid printing the (huge) contents of the ;; `backtrace' slot of the result objects in the ;; `most-recent-result' slots of test case objects in (eql ...) or ;; (member ...) selectors. (labels ((rec (selector) ;; This code needs to match the etypecase in `ert-select-tests'. (etypecase selector ((or (member nil t :new :failed :passed :expected :unexpected) string symbol) selector) (ert-test (if (ert-test-name selector) (make-symbol (format "<%S>" (ert-test-name selector))) (make-symbol ""))) (cons (destructuring-bind (operator &rest operands) selector (ecase operator ((member eql and not or) `(,operator ,@(mapcar #'rec operands))) ((member tag satisfies) selector))))))) (insert (format "%S" (rec selector))))) ;;; Facilities for running a whole set of tests. ;; The data structure that contains the set of tests being executed ;; during one particular test run, their results, the state of the ;; execution, and some statistics. ;; ;; The data about results and expected results of tests may seem ;; redundant here, since the test objects also carry such information. ;; However, the information in the test objects may be more recent, it ;; may correspond to a different test run. We need the information ;; that corresponds to this run in order to be able to update the ;; statistics correctly when a test is re-run interactively and has a ;; different result than before. (defstruct ert--stats (selector (assert nil)) ;; The tests, in order. (tests (assert nil) :type vector) ;; A map of test names (or the test objects themselves for unnamed ;; tests) to indices into the `tests' vector. (test-map (assert nil) :type hash-table) ;; The results of the tests during this run, in order. (test-results (assert nil) :type vector) ;; The start times of the tests, in order, as reported by ;; `current-time'. (test-start-times (assert nil) :type vector) ;; The end times of the tests, in order, as reported by ;; `current-time'. (test-end-times (assert nil) :type vector) (passed-expected 0) (passed-unexpected 0) (failed-expected 0) (failed-unexpected 0) (start-time nil) (end-time nil) (aborted-p nil) (current-test nil) ;; The time at or after which the next redisplay should occur, as a ;; float. (next-redisplay 0.0)) (defun ert-stats-completed-expected (stats) "Return the number of tests in STATS that had expected results." (+ (ert--stats-passed-expected stats) (ert--stats-failed-expected stats))) (defun ert-stats-completed-unexpected (stats) "Return the number of tests in STATS that had unexpected results." (+ (ert--stats-passed-unexpected stats) (ert--stats-failed-unexpected stats))) (defun ert-stats-completed (stats) "Number of tests in STATS that have run so far." (+ (ert-stats-completed-expected stats) (ert-stats-completed-unexpected stats))) (defun ert-stats-total (stats) "Number of tests in STATS, regardless of whether they have run yet." (length (ert--stats-tests stats))) ;; The stats object of the current run, dynamically bound. This is ;; used for the mode line progress indicator. (defvar ert--current-run-stats nil) (defun ert--stats-test-key (test) "Return the key used for TEST in the test map of ert--stats objects. Returns the name of TEST if it has one, or TEST itself otherwise." (or (ert-test-name test) test)) (defun ert--stats-set-test-and-result (stats pos test result) "Change STATS by replacing the test at position POS with TEST and RESULT. Also changes the counters in STATS to match." (let* ((tests (ert--stats-tests stats)) (results (ert--stats-test-results stats)) (old-test (aref tests pos)) (map (ert--stats-test-map stats))) (flet ((update (d) (if (ert-test-result-expected-p (aref tests pos) (aref results pos)) (etypecase (aref results pos) (ert-test-passed (incf (ert--stats-passed-expected stats) d)) (ert-test-failed (incf (ert--stats-failed-expected stats) d)) (null) (ert-test-aborted-with-non-local-exit) (ert-test-quit)) (etypecase (aref results pos) (ert-test-passed (incf (ert--stats-passed-unexpected stats) d)) (ert-test-failed (incf (ert--stats-failed-unexpected stats) d)) (null) (ert-test-aborted-with-non-local-exit) (ert-test-quit))))) ;; Adjust counters to remove the result that is currently in stats. (update -1) ;; Put new test and result into stats. (setf (aref tests pos) test (aref results pos) result) (remhash (ert--stats-test-key old-test) map) (setf (gethash (ert--stats-test-key test) map) pos) ;; Adjust counters to match new result. (update +1) nil))) (defun ert--make-stats (tests selector) "Create a new `ert--stats' object for running TESTS. SELECTOR is the selector that was used to select TESTS." (setq tests (ert--coerce-to-vector tests)) (let ((map (make-hash-table :size (length tests)))) (loop for i from 0 for test across tests for key = (ert--stats-test-key test) do (assert (not (gethash key map))) (setf (gethash key map) i)) (make-ert--stats :selector selector :tests tests :test-map map :test-results (make-vector (length tests) nil) :test-start-times (make-vector (length tests) nil) :test-end-times (make-vector (length tests) nil)))) (defun ert-run-or-rerun-test (stats test listener) ;; checkdoc-order: nil "Run the single test TEST and record the result using STATS and LISTENER." (let ((ert--current-run-stats stats) (pos (ert--stats-test-pos stats test))) (ert--stats-set-test-and-result stats pos test nil) ;; Call listener after setting/before resetting ;; (ert--stats-current-test stats); the listener might refresh the ;; mode line display, and if the value is not set yet/any more ;; during this refresh, the mode line will flicker unnecessarily. (setf (ert--stats-current-test stats) test) (funcall listener 'test-started stats test) (setf (ert-test-most-recent-result test) nil) (setf (aref (ert--stats-test-start-times stats) pos) (current-time)) (unwind-protect (ert-run-test test) (setf (aref (ert--stats-test-end-times stats) pos) (current-time)) (let ((result (ert-test-most-recent-result test))) (ert--stats-set-test-and-result stats pos test result) (funcall listener 'test-ended stats test result)) (setf (ert--stats-current-test stats) nil)))) (defun ert-run-tests (selector listener) "Run the tests specified by SELECTOR, sending progress updates to LISTENER." (let* ((tests (ert-select-tests selector t)) (stats (ert--make-stats tests selector))) (setf (ert--stats-start-time stats) (current-time)) (funcall listener 'run-started stats) (let ((abortedp t)) (unwind-protect (let ((ert--current-run-stats stats)) (force-mode-line-update) (unwind-protect (progn (loop for test in tests do (ert-run-or-rerun-test stats test listener)) (setq abortedp nil)) (setf (ert--stats-aborted-p stats) abortedp) (setf (ert--stats-end-time stats) (current-time)) (funcall listener 'run-ended stats abortedp))) (force-mode-line-update)) stats))) (defun ert--stats-test-pos (stats test) ;; checkdoc-order: nil "Return the position (index) of TEST in the run represented by STATS." (gethash (ert--stats-test-key test) (ert--stats-test-map stats))) ;;; Formatting functions shared across UIs. (defun ert--format-time-iso8601 (time) "Format TIME in the variant of ISO 8601 used for timestamps in ERT." (format-time-string "%Y-%m-%d %T%z" time)) (defun ert-char-for-test-result (result expectedp) "Return a character that represents the test result RESULT. EXPECTEDP specifies whether the result was expected." (let ((s (etypecase result (ert-test-passed ".P") (ert-test-failed "fF") (null "--") (ert-test-aborted-with-non-local-exit "aA") (ert-test-quit "qQ")))) (elt s (if expectedp 0 1)))) (defun ert-string-for-test-result (result expectedp) "Return a string that represents the test result RESULT. EXPECTEDP specifies whether the result was expected." (let ((s (etypecase result (ert-test-passed '("passed" "PASSED")) (ert-test-failed '("failed" "FAILED")) (null '("unknown" "UNKNOWN")) (ert-test-aborted-with-non-local-exit '("aborted" "ABORTED")) (ert-test-quit '("quit" "QUIT"))))) (elt s (if expectedp 0 1)))) (defun ert--pp-with-indentation-and-newline (object) "Pretty-print OBJECT, indenting it to the current column of point. Ensures a final newline is inserted." (let ((begin (point))) (pp object (current-buffer)) (unless (bolp) (insert "\n")) (save-excursion (goto-char begin) (indent-sexp)))) (defun ert--insert-infos (result) "Insert `ert-info' infos from RESULT into current buffer. RESULT must be an `ert-test-result-with-condition'." (check-type result ert-test-result-with-condition) (dolist (info (ert-test-result-with-condition-infos result)) (destructuring-bind (prefix . message) info (let ((begin (point)) (indentation (make-string (+ (length prefix) 4) ?\s)) (end nil)) (unwind-protect (progn (insert message "\n") (setq end (copy-marker (point))) (goto-char begin) (insert " " prefix) (forward-line 1) (while (< (point) end) (insert indentation) (forward-line 1))) (when end (set-marker end nil))))))) ;;; Running tests in batch mode. (defvar ert-batch-backtrace-right-margin 70 "The maximum line length for printing backtraces in `ert-run-tests-batch'.") ;;;###autoload (defun ert-run-tests-batch (&optional selector) "Run the tests specified by SELECTOR, printing results to the terminal. SELECTOR works as described in `ert-select-tests', except if SELECTOR is nil, in which case all tests rather than none will be run; this makes the command line \"emacs -batch -l my-tests.el -f ert-run-tests-batch-and-exit\" useful. Returns the stats object." (unless selector (setq selector 't)) (ert-run-tests selector (lambda (event-type &rest event-args) (ecase event-type (run-started (destructuring-bind (stats) event-args (message "Running %s tests (%s)" (length (ert--stats-tests stats)) (ert--format-time-iso8601 (ert--stats-start-time stats))))) (run-ended (destructuring-bind (stats abortedp) event-args (let ((unexpected (ert-stats-completed-unexpected stats)) (expected-failures (ert--stats-failed-expected stats))) (message "\n%sRan %s tests, %s results as expected%s (%s)%s\n" (if (not abortedp) "" "Aborted: ") (ert-stats-total stats) (ert-stats-completed-expected stats) (if (zerop unexpected) "" (format ", %s unexpected" unexpected)) (ert--format-time-iso8601 (ert--stats-end-time stats)) (if (zerop expected-failures) "" (format "\n%s expected failures" expected-failures))) (unless (zerop unexpected) (message "%s unexpected results:" unexpected) (loop for test across (ert--stats-tests stats) for result = (ert-test-most-recent-result test) do (when (not (ert-test-result-expected-p test result)) (message "%9s %S" (ert-string-for-test-result result nil) (ert-test-name test)))) (message "%s" ""))))) (test-started ) (test-ended (destructuring-bind (stats test result) event-args (unless (ert-test-result-expected-p test result) (etypecase result (ert-test-passed (message "Test %S passed unexpectedly" (ert-test-name test))) (ert-test-result-with-condition (message "Test %S backtrace:" (ert-test-name test)) (with-temp-buffer (ert--print-backtrace (ert-test-result-with-condition-backtrace result)) (goto-char (point-min)) (while (not (eobp)) (let ((start (point)) (end (progn (end-of-line) (point)))) (setq end (min end (+ start ert-batch-backtrace-right-margin))) (message "%s" (buffer-substring-no-properties start end))) (forward-line 1))) (with-temp-buffer (ert--insert-infos result) (insert " ") (let ((print-escape-newlines t) (print-level 5) (print-length 10)) (ert--pp-with-indentation-and-newline (ert-test-result-with-condition-condition result))) (goto-char (1- (point-max))) (assert (looking-at "\n")) (delete-char 1) (message "Test %S condition:" (ert-test-name test)) (message "%s" (buffer-string)))) (ert-test-aborted-with-non-local-exit (message "Test %S aborted with non-local exit" (ert-test-name test))) (ert-test-quit (message "Quit during %S" (ert-test-name test))))) (let* ((max (prin1-to-string (length (ert--stats-tests stats)))) (format-string (concat "%9s %" (prin1-to-string (length max)) "s/" max " %S"))) (message format-string (ert-string-for-test-result result (ert-test-result-expected-p test result)) (1+ (ert--stats-test-pos stats test)) (ert-test-name test))))))))) ;;;###autoload (defun ert-run-tests-batch-and-exit (&optional selector) "Like `ert-run-tests-batch', but exits Emacs when done. The exit status will be 0 if all test results were as expected, 1 on unexpected results, or 2 if the tool detected an error outside of the tests (e.g. invalid SELECTOR or bug in the code that runs the tests)." (unwind-protect (let ((stats (ert-run-tests-batch selector))) (kill-emacs (if (zerop (ert-stats-completed-unexpected stats)) 0 1))) (unwind-protect (progn (message "Error running tests") (backtrace)) (kill-emacs 2)))) ;;; Utility functions for load/unload actions. (defun ert--activate-font-lock-keywords () "Activate font-lock keywords for some of ERT's symbols." (font-lock-add-keywords nil '(("(\\(\\\\s *\\(\\sw+\\)?" (1 font-lock-keyword-face nil t) (2 font-lock-function-name-face nil t))))) (defun* ert--remove-from-list (list-var element &key key test) "Remove ELEMENT from the value of LIST-VAR if present. This can be used as an inverse of `add-to-list'." (unless key (setq key #'identity)) (unless test (setq test #'equal)) (setf (symbol-value list-var) (ert--remove* element (symbol-value list-var) :key key :test test))) ;;; Some basic interactive functions. (defun ert-read-test-name (prompt &optional default history add-default-to-prompt) "Read the name of a test and return it as a symbol. Prompt with PROMPT. If DEFAULT is a valid test name, use it as a default. HISTORY is the history to use; see `completing-read'. If ADD-DEFAULT-TO-PROMPT is non-nil, PROMPT will be modified to include the default, if any. Signals an error if no test name was read." (etypecase default (string (let ((symbol (intern-soft default))) (unless (and symbol (ert-test-boundp symbol)) (setq default nil)))) (symbol (setq default (if (ert-test-boundp default) (symbol-name default) nil))) (ert-test (setq default (ert-test-name default)))) (when add-default-to-prompt (setq prompt (if (null default) (format "%s: " prompt) (format "%s (default %s): " prompt default)))) (let ((input (completing-read prompt obarray #'ert-test-boundp t nil history default nil))) ;; completing-read returns an empty string if default was nil and ;; the user just hit enter. (let ((sym (intern-soft input))) (if (ert-test-boundp sym) sym (error "Input does not name a test"))))) (defun ert-read-test-name-at-point (prompt) "Read the name of a test and return it as a symbol. As a default, use the symbol at point, or the test at point if in the ERT results buffer. Prompt with PROMPT, augmented with the default (if any)." (ert-read-test-name prompt (ert-test-at-point) nil t)) (defun ert-find-test-other-window (test-name) "Find, in another window, the definition of TEST-NAME." (interactive (list (ert-read-test-name-at-point "Find test definition: "))) (find-function-do-it test-name 'ert-deftest 'switch-to-buffer-other-window)) (defun ert-delete-test (test-name) "Make the test TEST-NAME unbound. Nothing more than an interactive interface to `ert-make-test-unbound'." (interactive (list (ert-read-test-name-at-point "Delete test"))) (ert-make-test-unbound test-name)) (defun ert-delete-all-tests () "Make all symbols in `obarray' name no test." (interactive) (when (called-interactively-p 'any) (unless (y-or-n-p "Delete all tests? ") (error "Aborted"))) ;; We can't use `ert-select-tests' here since that gives us only ;; test objects, and going from them back to the test name symbols ;; can fail if the `ert-test' defstruct has been redefined. (mapc #'ert-make-test-unbound (apropos-internal "" #'ert-test-boundp)) t) ;;; Display of test progress and results. ;; An entry in the results buffer ewoc. There is one entry per test. (defstruct ert--ewoc-entry (test (assert nil)) ;; If the result of this test was expected, its ewoc entry is hidden ;; initially. (hidden-p (assert nil)) ;; An ewoc entry may be collapsed to hide details such as the error ;; condition. ;; ;; I'm not sure the ability to expand and collapse entries is still ;; a useful feature. (expanded-p t) ;; By default, the ewoc entry presents the error condition with ;; certain limits on how much to print (`print-level', ;; `print-length'). The user can interactively switch to a set of ;; higher limits. (extended-printer-limits-p nil)) ;; Variables local to the results buffer. ;; The ewoc. (defvar ert--results-ewoc) ;; The stats object. (defvar ert--results-stats) ;; A string with one character per test. Each character represents ;; the result of the corresponding test. The string is displayed near ;; the top of the buffer and serves as a progress bar. (defvar ert--results-progress-bar-string) ;; The position where the progress bar button begins. (defvar ert--results-progress-bar-button-begin) ;; The test result listener that updates the buffer when tests are run. (defvar ert--results-listener) (defun ert-insert-test-name-button (test-name) "Insert a button that links to TEST-NAME." (insert-text-button (format "%S" test-name) :type 'ert--test-name-button 'ert-test-name test-name)) (defun ert--results-format-expected-unexpected (expected unexpected) "Return a string indicating EXPECTED expected results, UNEXPECTED unexpected." (if (zerop unexpected) (format "%s" expected) (format "%s (%s unexpected)" (+ expected unexpected) unexpected))) (defun ert--results-update-ewoc-hf (ewoc stats) "Update the header and footer of EWOC to show certain information from STATS. Also sets `ert--results-progress-bar-button-begin'." (let ((run-count (ert-stats-completed stats)) (results-buffer (current-buffer)) ;; Need to save buffer-local value. (font-lock font-lock-mode)) (ewoc-set-hf ewoc ;; header (with-temp-buffer (insert "Selector: ") (ert--insert-human-readable-selector (ert--stats-selector stats)) (insert "\n") (insert (format (concat "Passed: %s\n" "Failed: %s\n" "Total: %s/%s\n\n") (ert--results-format-expected-unexpected (ert--stats-passed-expected stats) (ert--stats-passed-unexpected stats)) (ert--results-format-expected-unexpected (ert--stats-failed-expected stats) (ert--stats-failed-unexpected stats)) run-count (ert-stats-total stats))) (insert (format "Started at: %s\n" (ert--format-time-iso8601 (ert--stats-start-time stats)))) ;; FIXME: This is ugly. Need to properly define invariants of ;; the `stats' data structure. (let ((state (cond ((ert--stats-aborted-p stats) 'aborted) ((ert--stats-current-test stats) 'running) ((ert--stats-end-time stats) 'finished) (t 'preparing)))) (ecase state (preparing (insert "")) (aborted (cond ((ert--stats-current-test stats) (insert "Aborted during test: ") (ert-insert-test-name-button (ert-test-name (ert--stats-current-test stats)))) (t (insert "Aborted.")))) (running (assert (ert--stats-current-test stats)) (insert "Running test: ") (ert-insert-test-name-button (ert-test-name (ert--stats-current-test stats)))) (finished (assert (not (ert--stats-current-test stats))) (insert "Finished."))) (insert "\n") (if (ert--stats-end-time stats) (insert (format "%s%s\n" (if (ert--stats-aborted-p stats) "Aborted at: " "Finished at: ") (ert--format-time-iso8601 (ert--stats-end-time stats)))) (insert "\n")) (insert "\n")) (let ((progress-bar-string (with-current-buffer results-buffer ert--results-progress-bar-string))) (let ((progress-bar-button-begin (insert-text-button progress-bar-string :type 'ert--results-progress-bar-button 'face (or (and font-lock (ert-face-for-stats stats)) 'button)))) ;; The header gets copied verbatim to the results buffer, ;; and all positions remain the same, so ;; `progress-bar-button-begin' will be the right position ;; even in the results buffer. (with-current-buffer results-buffer (set (make-local-variable 'ert--results-progress-bar-button-begin) progress-bar-button-begin)))) (insert "\n\n") (buffer-string)) ;; footer ;; ;; We actually want an empty footer, but that would trigger a bug ;; in ewoc, sometimes clearing the entire buffer. (It's possible ;; that this bug has been fixed since this has been tested; we ;; should test it again.) "\n"))) (defvar ert-test-run-redisplay-interval-secs .1 "How many seconds ERT should wait between redisplays while running tests. While running tests, ERT shows the current progress, and this variable determines how frequently the progress display is updated.") (defun ert--results-update-stats-display (ewoc stats) "Update EWOC and the mode line to show data from STATS." ;; TODO(ohler): investigate using `make-progress-reporter'. (ert--results-update-ewoc-hf ewoc stats) (force-mode-line-update) (redisplay t) (setf (ert--stats-next-redisplay stats) (+ (float-time) ert-test-run-redisplay-interval-secs))) (defun ert--results-update-stats-display-maybe (ewoc stats) "Call `ert--results-update-stats-display' if not called recently. EWOC and STATS are arguments for `ert--results-update-stats-display'." (when (>= (float-time) (ert--stats-next-redisplay stats)) (ert--results-update-stats-display ewoc stats))) (defun ert--tests-running-mode-line-indicator () "Return a string for the mode line that shows the test run progress." (let* ((stats ert--current-run-stats) (tests-total (ert-stats-total stats)) (tests-completed (ert-stats-completed stats))) (if (>= tests-completed tests-total) (format " ERT(%s/%s,finished)" tests-completed tests-total) (format " ERT(%s/%s):%s" (1+ tests-completed) tests-total (if (null (ert--stats-current-test stats)) "?" (format "%S" (ert-test-name (ert--stats-current-test stats)))))))) (defun ert--make-xrefs-region (begin end) "Attach cross-references to function names between BEGIN and END. BEGIN and END specify a region in the current buffer." (save-excursion (save-restriction (narrow-to-region begin end) ;; Inhibit optimization in `debugger-make-xrefs' that would ;; sometimes insert unrelated backtrace info into our buffer. (let ((debugger-previous-backtrace nil)) (debugger-make-xrefs))))) (defun ert--string-first-line (s) "Return the first line of S, or S if it contains no newlines. The return value does not include the line terminator." (substring s 0 (ert--string-position ?\n s))) (defun ert-face-for-test-result (expectedp) "Return a face that shows whether a test result was expected or unexpected. If EXPECTEDP is nil, returns the face for unexpected results; if non-nil, returns the face for expected results.." (if expectedp 'ert-test-result-expected 'ert-test-result-unexpected)) (defun ert-face-for-stats (stats) "Return a face that represents STATS." (cond ((ert--stats-aborted-p stats) 'nil) ((plusp (ert-stats-completed-unexpected stats)) (ert-face-for-test-result nil)) ((eql (ert-stats-completed-expected stats) (ert-stats-total stats)) (ert-face-for-test-result t)) (t 'nil))) (defun ert--print-test-for-ewoc (entry) "The ewoc print function for ewoc test entries. ENTRY is the entry to print." (let* ((test (ert--ewoc-entry-test entry)) (stats ert--results-stats) (result (let ((pos (ert--stats-test-pos stats test))) (assert pos) (aref (ert--stats-test-results stats) pos))) (hiddenp (ert--ewoc-entry-hidden-p entry)) (expandedp (ert--ewoc-entry-expanded-p entry)) (extended-printer-limits-p (ert--ewoc-entry-extended-printer-limits-p entry))) (cond (hiddenp) (t (let ((expectedp (ert-test-result-expected-p test result))) (insert-text-button (format "%c" (ert-char-for-test-result result expectedp)) :type 'ert--results-expand-collapse-button 'face (or (and font-lock-mode (ert-face-for-test-result expectedp)) 'button))) (insert " ") (ert-insert-test-name-button (ert-test-name test)) (insert "\n") (when (and expandedp (not (eql result 'nil))) (when (ert-test-documentation test) (insert " " (propertize (ert--string-first-line (ert-test-documentation test)) 'font-lock-face 'font-lock-doc-face) "\n")) (etypecase result (ert-test-passed (if (ert-test-result-expected-p test result) (insert " passed\n") (insert " passed unexpectedly\n")) (insert "")) (ert-test-result-with-condition (ert--insert-infos result) (let ((print-escape-newlines t) (print-level (if extended-printer-limits-p 12 6)) (print-length (if extended-printer-limits-p 100 10))) (insert " ") (let ((begin (point))) (ert--pp-with-indentation-and-newline (ert-test-result-with-condition-condition result)) (ert--make-xrefs-region begin (point))))) (ert-test-aborted-with-non-local-exit (insert " aborted\n")) (ert-test-quit (insert " quit\n"))) (insert "\n"))))) nil) (defun ert--results-font-lock-function (enabledp) "Redraw the ERT results buffer after font-lock-mode was switched on or off. ENABLEDP is true if font-lock-mode is switched on, false otherwise." (ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats) (ewoc-refresh ert--results-ewoc) (font-lock-default-function enabledp)) (defun ert--setup-results-buffer (stats listener buffer-name) "Set up a test results buffer. STATS is the stats object; LISTENER is the results listener; BUFFER-NAME, if non-nil, is the buffer name to use." (unless buffer-name (setq buffer-name "*ert*")) (let ((buffer (get-buffer-create buffer-name))) (with-current-buffer buffer (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) (ert-results-mode) ;; Erase buffer again in case switching out of the previous ;; mode inserted anything. (This happens e.g. when switching ;; from ert-results-mode to ert-results-mode when ;; font-lock-mode turns itself off in change-major-mode-hook.) (erase-buffer) (set (make-local-variable 'font-lock-function) 'ert--results-font-lock-function) (let ((ewoc (ewoc-create 'ert--print-test-for-ewoc nil nil t))) (set (make-local-variable 'ert--results-ewoc) ewoc) (set (make-local-variable 'ert--results-stats) stats) (set (make-local-variable 'ert--results-progress-bar-string) (make-string (ert-stats-total stats) (ert-char-for-test-result nil t))) (set (make-local-variable 'ert--results-listener) listener) (loop for test across (ert--stats-tests stats) do (ewoc-enter-last ewoc (make-ert--ewoc-entry :test test :hidden-p t))) (ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats) (goto-char (1- (point-max))) buffer))))) (defvar ert--selector-history nil "List of recent test selectors read from terminal.") ;; Should OUTPUT-BUFFER-NAME and MESSAGE-FN really be arguments here? ;; They are needed only for our automated self-tests at the moment. ;; Or should there be some other mechanism? ;;;###autoload (defun ert-run-tests-interactively (selector &optional output-buffer-name message-fn) "Run the tests specified by SELECTOR and display the results in a buffer. SELECTOR works as described in `ert-select-tests'. OUTPUT-BUFFER-NAME and MESSAGE-FN should normally be nil; they are used for automated self-tests and specify which buffer to use and how to display message." (interactive (list (let ((default (if ert--selector-history ;; Can't use `first' here as this form is ;; not compiled, and `first' is not ;; defined without cl. (car ert--selector-history) "t"))) (read-from-minibuffer (if (null default) "Run tests: " (format "Run tests (default %s): " default)) nil nil t 'ert--selector-history default nil)) nil)) (unless message-fn (setq message-fn 'message)) (lexical-let ((output-buffer-name output-buffer-name) buffer listener (message-fn message-fn)) (setq listener (lambda (event-type &rest event-args) (ecase event-type (run-started (destructuring-bind (stats) event-args (setq buffer (ert--setup-results-buffer stats listener output-buffer-name)) (pop-to-buffer buffer))) (run-ended (destructuring-bind (stats abortedp) event-args (funcall message-fn "%sRan %s tests, %s results were as expected%s" (if (not abortedp) "" "Aborted: ") (ert-stats-total stats) (ert-stats-completed-expected stats) (let ((unexpected (ert-stats-completed-unexpected stats))) (if (zerop unexpected) "" (format ", %s unexpected" unexpected)))) (ert--results-update-stats-display (with-current-buffer buffer ert--results-ewoc) stats))) (test-started (destructuring-bind (stats test) event-args (with-current-buffer buffer (let* ((ewoc ert--results-ewoc) (pos (ert--stats-test-pos stats test)) (node (ewoc-nth ewoc pos))) (assert node) (setf (ert--ewoc-entry-test (ewoc-data node)) test) (aset ert--results-progress-bar-string pos (ert-char-for-test-result nil t)) (ert--results-update-stats-display-maybe ewoc stats) (ewoc-invalidate ewoc node))))) (test-ended (destructuring-bind (stats test result) event-args (with-current-buffer buffer (let* ((ewoc ert--results-ewoc) (pos (ert--stats-test-pos stats test)) (node (ewoc-nth ewoc pos))) (when (ert--ewoc-entry-hidden-p (ewoc-data node)) (setf (ert--ewoc-entry-hidden-p (ewoc-data node)) (ert-test-result-expected-p test result))) (aset ert--results-progress-bar-string pos (ert-char-for-test-result result (ert-test-result-expected-p test result))) (ert--results-update-stats-display-maybe ewoc stats) (ewoc-invalidate ewoc node)))))))) (ert-run-tests selector listener))) ;;;###autoload (defalias 'ert 'ert-run-tests-interactively) ;;; Simple view mode for auxiliary information like stack traces or ;;; messages. Mainly binds "q" for quit. (define-derived-mode ert-simple-view-mode special-mode "ERT-View" "Major mode for viewing auxiliary information in ERT.") ;;; Commands and button actions for the results buffer. (define-derived-mode ert-results-mode special-mode "ERT-Results" "Major mode for viewing results of ERT test runs.") (loop for (key binding) in '(;; Stuff that's not in the menu. ("\t" forward-button) ([backtab] backward-button) ("j" ert-results-jump-between-summary-and-result) ("L" ert-results-toggle-printer-limits-for-test-at-point) ("n" ert-results-next-test) ("p" ert-results-previous-test) ;; Stuff that is in the menu. ("R" ert-results-rerun-all-tests) ("r" ert-results-rerun-test-at-point) ("d" ert-results-rerun-test-at-point-debugging-errors) ("." ert-results-find-test-at-point-other-window) ("b" ert-results-pop-to-backtrace-for-test-at-point) ("m" ert-results-pop-to-messages-for-test-at-point) ("l" ert-results-pop-to-should-forms-for-test-at-point) ("h" ert-results-describe-test-at-point) ("D" ert-delete-test) ("T" ert-results-pop-to-timings) ) do (define-key ert-results-mode-map key binding)) (easy-menu-define ert-results-mode-menu ert-results-mode-map "Menu for `ert-results-mode'." '("ERT Results" ["Re-run all tests" ert-results-rerun-all-tests] "--" ["Re-run test" ert-results-rerun-test-at-point] ["Debug test" ert-results-rerun-test-at-point-debugging-errors] ["Show test definition" ert-results-find-test-at-point-other-window] "--" ["Show backtrace" ert-results-pop-to-backtrace-for-test-at-point] ["Show messages" ert-results-pop-to-messages-for-test-at-point] ["Show `should' forms" ert-results-pop-to-should-forms-for-test-at-point] ["Describe test" ert-results-describe-test-at-point] "--" ["Delete test" ert-delete-test] "--" ["Show execution time of each test" ert-results-pop-to-timings] )) (define-button-type 'ert--results-progress-bar-button 'action #'ert--results-progress-bar-button-action 'help-echo "mouse-2, RET: Reveal test result") (define-button-type 'ert--test-name-button 'action #'ert--test-name-button-action 'help-echo "mouse-2, RET: Find test definition") (define-button-type 'ert--results-expand-collapse-button 'action #'ert--results-expand-collapse-button-action 'help-echo "mouse-2, RET: Expand/collapse test result") (defun ert--results-test-node-or-null-at-point () "If point is on a valid ewoc node, return it; return nil otherwise. To be used in the ERT results buffer." (let* ((ewoc ert--results-ewoc) (node (ewoc-locate ewoc))) ;; `ewoc-locate' will return an arbitrary node when point is on ;; header or footer, or when all nodes are invisible. So we need ;; to validate its return value here. ;; ;; Update: I'm seeing nil being returned in some cases now, ;; perhaps this has been changed? (if (and node (>= (point) (ewoc-location node)) (not (ert--ewoc-entry-hidden-p (ewoc-data node)))) node nil))) (defun ert--results-test-node-at-point () "If point is on a valid ewoc node, return it; signal an error otherwise. To be used in the ERT results buffer." (or (ert--results-test-node-or-null-at-point) (error "No test at point"))) (defun ert-results-next-test () "Move point to the next test. To be used in the ERT results buffer." (interactive) (ert--results-move (ewoc-locate ert--results-ewoc) 'ewoc-next "No tests below")) (defun ert-results-previous-test () "Move point to the previous test. To be used in the ERT results buffer." (interactive) (ert--results-move (ewoc-locate ert--results-ewoc) 'ewoc-prev "No tests above")) (defun ert--results-move (node ewoc-fn error-message) "Move point from NODE to the previous or next node. EWOC-FN specifies the direction and should be either `ewoc-prev' or `ewoc-next'. If there are no more nodes in that direction, an error is signaled with the message ERROR-MESSAGE." (loop (setq node (funcall ewoc-fn ert--results-ewoc node)) (when (null node) (error "%s" error-message)) (unless (ert--ewoc-entry-hidden-p (ewoc-data node)) (goto-char (ewoc-location node)) (return)))) (defun ert--results-expand-collapse-button-action (button) "Expand or collapse the test node BUTTON belongs to." (let* ((ewoc ert--results-ewoc) (node (save-excursion (goto-char (ert--button-action-position)) (ert--results-test-node-at-point))) (entry (ewoc-data node))) (setf (ert--ewoc-entry-expanded-p entry) (not (ert--ewoc-entry-expanded-p entry))) (ewoc-invalidate ewoc node))) (defun ert-results-find-test-at-point-other-window () "Find the definition of the test at point in another window. To be used in the ERT results buffer." (interactive) (let ((name (ert-test-at-point))) (unless name (error "No test at point")) (ert-find-test-other-window name))) (defun ert--test-name-button-action (button) "Find the definition of the test BUTTON belongs to, in another window." (let ((name (button-get button 'ert-test-name))) (ert-find-test-other-window name))) (defun ert--ewoc-position (ewoc node) ;; checkdoc-order: nil "Return the position of NODE in EWOC, or nil if NODE is not in EWOC." (loop for i from 0 for node-here = (ewoc-nth ewoc 0) then (ewoc-next ewoc node-here) do (when (eql node node-here) (return i)) finally (return nil))) (defun ert-results-jump-between-summary-and-result () "Jump back and forth between the test run summary and individual test results. From an ewoc node, jumps to the character that represents the same test in the progress bar, and vice versa. To be used in the ERT results buffer." ;; Maybe this command isn't actually needed much, but if it is, it ;; seems like an indication that the UI design is not optimal. If ;; jumping back and forth between a summary at the top of the buffer ;; and the error log in the remainder of the buffer is useful, then ;; the summary apparently needs to be easily accessible from the ;; error log, and perhaps it would be better to have it in a ;; separate buffer to keep it visible. (interactive) (let ((ewoc ert--results-ewoc) (progress-bar-begin ert--results-progress-bar-button-begin)) (cond ((ert--results-test-node-or-null-at-point) (let* ((node (ert--results-test-node-at-point)) (pos (ert--ewoc-position ewoc node))) (goto-char (+ progress-bar-begin pos)))) ((and (<= progress-bar-begin (point)) (< (point) (button-end (button-at progress-bar-begin)))) (let* ((node (ewoc-nth ewoc (- (point) progress-bar-begin))) (entry (ewoc-data node))) (when (ert--ewoc-entry-hidden-p entry) (setf (ert--ewoc-entry-hidden-p entry) nil) (ewoc-invalidate ewoc node)) (ewoc-goto-node ewoc node))) (t (goto-char progress-bar-begin))))) (defun ert-test-at-point () "Return the name of the test at point as a symbol, or nil if none." (or (and (eql major-mode 'ert-results-mode) (let ((test (ert--results-test-at-point-no-redefinition))) (and test (ert-test-name test)))) (let* ((thing (thing-at-point 'symbol)) (sym (intern-soft thing))) (and (ert-test-boundp sym) sym)))) (defun ert--results-test-at-point-no-redefinition () "Return the test at point, or nil. To be used in the ERT results buffer." (assert (eql major-mode 'ert-results-mode)) (if (ert--results-test-node-or-null-at-point) (let* ((node (ert--results-test-node-at-point)) (test (ert--ewoc-entry-test (ewoc-data node)))) test) (let ((progress-bar-begin ert--results-progress-bar-button-begin)) (when (and (<= progress-bar-begin (point)) (< (point) (button-end (button-at progress-bar-begin)))) (let* ((test-index (- (point) progress-bar-begin)) (test (aref (ert--stats-tests ert--results-stats) test-index))) test))))) (defun ert--results-test-at-point-allow-redefinition () "Look up the test at point, and check whether it has been redefined. To be used in the ERT results buffer. Returns a list of two elements: the test (or nil) and a symbol specifying whether the test has been redefined. If a new test has been defined with the same name as the test at point, replaces the test at point with the new test, and returns the new test and the symbol `redefined'. If the test has been deleted, returns the old test and the symbol `deleted'. If the test is still current, returns the test and the symbol nil. If there is no test at point, returns a list with two nils." (let ((test (ert--results-test-at-point-no-redefinition))) (cond ((null test) `(nil nil)) ((null (ert-test-name test)) `(,test nil)) (t (let* ((name (ert-test-name test)) (new-test (and (ert-test-boundp name) (ert-get-test name)))) (cond ((eql test new-test) `(,test nil)) ((null new-test) `(,test deleted)) (t (ert--results-update-after-test-redefinition (ert--stats-test-pos ert--results-stats test) new-test) `(,new-test redefined)))))))) (defun ert--results-update-after-test-redefinition (pos new-test) "Update results buffer after the test at pos POS has been redefined. Also updates the stats object. NEW-TEST is the new test definition." (let* ((stats ert--results-stats) (ewoc ert--results-ewoc) (node (ewoc-nth ewoc pos)) (entry (ewoc-data node))) (ert--stats-set-test-and-result stats pos new-test nil) (setf (ert--ewoc-entry-test entry) new-test (aref ert--results-progress-bar-string pos) (ert-char-for-test-result nil t)) (ewoc-invalidate ewoc node)) nil) (defun ert--button-action-position () "The buffer position where the last button action was triggered." (cond ((integerp last-command-event) (point)) ((eventp last-command-event) (posn-point (event-start last-command-event))) (t (assert nil)))) (defun ert--results-progress-bar-button-action (button) "Jump to details for the test represented by the character clicked in BUTTON." (goto-char (ert--button-action-position)) (ert-results-jump-between-summary-and-result)) (defun ert-results-rerun-all-tests () "Re-run all tests, using the same selector. To be used in the ERT results buffer." (interactive) (assert (eql major-mode 'ert-results-mode)) (let ((selector (ert--stats-selector ert--results-stats))) (ert-run-tests-interactively selector (buffer-name)))) (defun ert-results-rerun-test-at-point () "Re-run the test at point. To be used in the ERT results buffer." (interactive) (destructuring-bind (test redefinition-state) (ert--results-test-at-point-allow-redefinition) (when (null test) (error "No test at point")) (let* ((stats ert--results-stats) (progress-message (format "Running %stest %S" (ecase redefinition-state ((nil) "") (redefined "new definition of ") (deleted "deleted ")) (ert-test-name test)))) ;; Need to save and restore point manually here: When point is on ;; the first visible ewoc entry while the header is updated, point ;; moves to the top of the buffer. This is undesirable, and a ;; simple `save-excursion' doesn't prevent it. (let ((point (point))) (unwind-protect (unwind-protect (progn (message "%s..." progress-message) (ert-run-or-rerun-test stats test ert--results-listener)) (ert--results-update-stats-display ert--results-ewoc stats) (message "%s...%s" progress-message (let ((result (ert-test-most-recent-result test))) (ert-string-for-test-result result (ert-test-result-expected-p test result))))) (goto-char point)))))) (defun ert-results-rerun-test-at-point-debugging-errors () "Re-run the test at point with `ert-debug-on-error' bound to t. To be used in the ERT results buffer." (interactive) (let ((ert-debug-on-error t)) (ert-results-rerun-test-at-point))) (defun ert-results-pop-to-backtrace-for-test-at-point () "Display the backtrace for the test at point. To be used in the ERT results buffer." (interactive) (let* ((test (ert--results-test-at-point-no-redefinition)) (stats ert--results-stats) (pos (ert--stats-test-pos stats test)) (result (aref (ert--stats-test-results stats) pos))) (etypecase result (ert-test-passed (error "Test passed, no backtrace available")) (ert-test-result-with-condition (let ((backtrace (ert-test-result-with-condition-backtrace result)) (buffer (get-buffer-create "*ERT Backtrace*"))) (pop-to-buffer buffer) (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) (ert-simple-view-mode) ;; Use unibyte because `debugger-setup-buffer' also does so. (set-buffer-multibyte nil) (setq truncate-lines t) (ert--print-backtrace backtrace) (debugger-make-xrefs) (goto-char (point-min)) (insert "Backtrace for test `") (ert-insert-test-name-button (ert-test-name test)) (insert "':\n"))))))) (defun ert-results-pop-to-messages-for-test-at-point () "Display the part of the *Messages* buffer generated during the test at point. To be used in the ERT results buffer." (interactive) (let* ((test (ert--results-test-at-point-no-redefinition)) (stats ert--results-stats) (pos (ert--stats-test-pos stats test)) (result (aref (ert--stats-test-results stats) pos))) (let ((buffer (get-buffer-create "*ERT Messages*"))) (pop-to-buffer buffer) (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) (ert-simple-view-mode) (insert (ert-test-result-messages result)) (goto-char (point-min)) (insert "Messages for test `") (ert-insert-test-name-button (ert-test-name test)) (insert "':\n"))))) (defun ert-results-pop-to-should-forms-for-test-at-point () "Display the list of `should' forms executed during the test at point. To be used in the ERT results buffer." (interactive) (let* ((test (ert--results-test-at-point-no-redefinition)) (stats ert--results-stats) (pos (ert--stats-test-pos stats test)) (result (aref (ert--stats-test-results stats) pos))) (let ((buffer (get-buffer-create "*ERT list of should forms*"))) (pop-to-buffer buffer) (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) (ert-simple-view-mode) (if (null (ert-test-result-should-forms result)) (insert "\n(No should forms during this test.)\n") (loop for form-description in (ert-test-result-should-forms result) for i from 1 do (insert "\n") (insert (format "%s: " i)) (let ((begin (point))) (ert--pp-with-indentation-and-newline form-description) (ert--make-xrefs-region begin (point))))) (goto-char (point-min)) (insert "`should' forms executed during test `") (ert-insert-test-name-button (ert-test-name test)) (insert "':\n") (insert "\n") (insert (concat "(Values are shallow copies and may have " "looked different during the test if they\n" "have been modified destructively.)\n")) (forward-line 1))))) (defun ert-results-toggle-printer-limits-for-test-at-point () "Toggle how much of the condition to print for the test at point. To be used in the ERT results buffer." (interactive) (let* ((ewoc ert--results-ewoc) (node (ert--results-test-node-at-point)) (entry (ewoc-data node))) (setf (ert--ewoc-entry-extended-printer-limits-p entry) (not (ert--ewoc-entry-extended-printer-limits-p entry))) (ewoc-invalidate ewoc node))) (defun ert-results-pop-to-timings () "Display test timings for the last run. To be used in the ERT results buffer." (interactive) (let* ((stats ert--results-stats) (start-times (ert--stats-test-start-times stats)) (end-times (ert--stats-test-end-times stats)) (buffer (get-buffer-create "*ERT timings*")) (data (loop for test across (ert--stats-tests stats) for start-time across (ert--stats-test-start-times stats) for end-time across (ert--stats-test-end-times stats) collect (list test (float-time (subtract-time end-time start-time)))))) (setq data (sort data (lambda (a b) (> (second a) (second b))))) (pop-to-buffer buffer) (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) (ert-simple-view-mode) (if (null data) (insert "(No data)\n") (insert (format "%-3s %8s %8s\n" "" "time" "cumul")) (loop for (test time) in data for cumul-time = time then (+ cumul-time time) for i from 1 do (let ((begin (point))) (insert (format "%3s: %8.3f %8.3f " i time cumul-time)) (ert-insert-test-name-button (ert-test-name test)) (insert "\n")))) (goto-char (point-min)) (insert "Tests by run time (seconds):\n\n") (forward-line 1)))) ;;;###autoload (defun ert-describe-test (test-or-test-name) "Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test)." (interactive (list (ert-read-test-name-at-point "Describe test"))) (when (< emacs-major-version 24) (error "Requires Emacs 24")) (let (test-name test-definition) (etypecase test-or-test-name (symbol (setq test-name test-or-test-name test-definition (ert-get-test test-or-test-name))) (ert-test (setq test-name (ert-test-name test-or-test-name) test-definition test-or-test-name))) (help-setup-xref (list #'ert-describe-test test-or-test-name) (called-interactively-p 'interactive)) (save-excursion (with-help-window (help-buffer) (with-current-buffer (help-buffer) (insert (if test-name (format "%S" test-name) "")) (insert " is a test") (let ((file-name (and test-name (symbol-file test-name 'ert-deftest)))) (when file-name (insert " defined in `" (file-name-nondirectory file-name) "'") (save-excursion (re-search-backward "`\\([^`']+\\)'" nil t) (help-xref-button 1 'help-function-def test-name file-name))) (insert ".") (fill-region-as-paragraph (point-min) (point)) (insert "\n\n") (unless (and (ert-test-boundp test-name) (eql (ert-get-test test-name) test-definition)) (let ((begin (point))) (insert "Note: This test has been redefined or deleted, " "this documentation refers to an old definition.") (fill-region-as-paragraph begin (point))) (insert "\n\n")) (insert (or (ert-test-documentation test-definition) "It is not documented.") "\n"))))))) (defun ert-results-describe-test-at-point () "Display the documentation of the test at point. To be used in the ERT results buffer." (interactive) (ert-describe-test (ert--results-test-at-point-no-redefinition))) ;;; Actions on load/unload. (add-to-list 'find-function-regexp-alist '(ert-deftest . ert--find-test-regexp)) (add-to-list 'minor-mode-alist '(ert--current-run-stats (:eval (ert--tests-running-mode-line-indicator)))) (add-to-list 'emacs-lisp-mode-hook 'ert--activate-font-lock-keywords) (defun ert--unload-function () "Unload function to undo the side-effects of loading ert.el." (ert--remove-from-list 'find-function-regexp-alist 'ert-deftest :key #'car) (ert--remove-from-list 'minor-mode-alist 'ert--current-run-stats :key #'car) (ert--remove-from-list 'emacs-lisp-mode-hook 'ert--activate-font-lock-keywords) nil) (defvar ert-unload-hook '()) (add-hook 'ert-unload-hook 'ert--unload-function) (provide 'ert) ;;; ert.el ends here haskell-mode-13.14.2/tests/haskell-indent-tests.el000066400000000000000000000024741253441665600220000ustar00rootroot00000000000000(require 'ert) (require 'haskell-indent) (require 'haskell-mode) (ert-deftest haskell-indent-in-comment-1 () "Document bad behavior. Should not assert." :expected-result :failed ;; Emacs 25 (snapshot) starts debugger on cl-assert ;; even in batch mode. So we do not run this test. (skip-unless (< emacs-major-version 25)) (should (with-temp-buffer (haskell-mode) (haskell-indent-mode) (insert (concat "module Test where\n" "-- {{{ A header\n" "--\n")) (indent-for-tab-command) t))) ;; haskell-indent-put-region-in-literate happens to be in haskell-indent ;; when the function is moved, move the tests also (ert-deftest haskell-indent-put-region-in-literate-1 () (should (equal "> literate" (with-temp-buffer (insert "literate") (literate-haskell-mode) (haskell-indent-put-region-in-literate (point-min) (point-max)) (buffer-substring-no-properties (point-min) (point-max)))))) (ert-deftest haskell-indent-put-region-in-literate-2 () :expected-result (if (< emacs-major-version 24) :failed :passed) (should (equal "literate" (with-temp-buffer (insert "> literate") (literate-haskell-mode) (haskell-indent-put-region-in-literate (point-min) (point-max) -1) (buffer-substring-no-properties (point-min) (point-max)))))) haskell-mode-13.14.2/tests/haskell-indentation-tests.el000066400000000000000000000113531253441665600230270ustar00rootroot00000000000000(require 'ert) (require 'haskell-indentation) (require 'haskell-mode) (require 'cl-lib) (defun haskell-indentation-check (&rest lines) "Check if `haskell-indentation-find-indentations` returns expected list of positions. LINES is the lines to insert to a temp buffer. Last line is not inserted, it is treated as a pattern of indentation points marked by '^' characters in positions. Point will be set on the *last* line inserted in the buffer so if you need to test indentation *past* source code on empty line then an empty line must be specified. Example of lines: \"func = do\" \" x\" \" ^\" " (with-temp-buffer (haskell-mode) (haskell-indentation-mode) (let (expected indentations (result "")) (dolist (line lines) (when expected (insert expected) (insert "\n")) (setq expected line)) (forward-line -1) (setq indentations (haskell-indentation-find-indentations)) (dotimes (i (1+ (apply #'max indentations))) (setq result (concat result (if (memq i indentations) "^" " ")))) (should (equal expected result))))) (ert-deftest haskell-indentation-check-1 () "Check if '{' on its own line gets properly indented" (haskell-indentation-check "function = Record" " { field = 123 }" "^ ^")) (ert-deftest haskell-indentation-check-2 () "Handle underscore in identifiers" (haskell-indentation-check "function = do" " (_x) <- return ()" " z" "^ ^ ^")) (ert-deftest haskell-indentation-check-2a () "Handle apostrophe in identifiers" (haskell-indentation-check "function = do" " (_'x') <- return ()" " z" "^ ^ ^")) (ert-deftest haskell-indentation-check-3 () "Import statememnt symbol list 1" (haskell-indentation-check "import Control.Concurrent" " ( forkIO," " killThread)" " ^")) (ert-deftest haskell-indentation-check-4 () "Import statememnt symbol list 2" :expected-result :failed (haskell-indentation-check "import Control.Concurrent" " ( forkIO" " , killThread)" " ^")) (ert-deftest haskell-indentation-check-5 () "List comprehension" (haskell-indentation-check "fun = [ x | y" " , z ]" " ^")) (ert-deftest haskell-indentation-check-5a () "List comprehension" :expected-result :failed (haskell-indentation-check "fun = [ x | y," " z ]" " ^")) (ert-deftest haskell-indentation-check-6 () "let in list comprehension" :expected-result :failed (haskell-indentation-check "fun = [ f | x <- xs" " , y <- ys" " , let c = 123" " , f <- fx x y c ]" " ^")) (ert-deftest haskell-indentation-check-7 () "import after import" :expected-result :failed (haskell-indentation-check "import ABC" "import DEF" "^")) (ert-deftest haskell-indentation-check-8 () "Guards in function definition" (haskell-indentation-check "resolve (amount, max) number" " | number > max = (1, number)" " | number == max = (amount + 1, number)" " ^")) (ert-deftest haskell-indentation-check-9 () "Operator last on line" :expected-result :failed (haskell-indentation-check "fun = x ++" " ^")) (ert-deftest haskell-indentation-check-10 () "Operator first on line" :expected-result :failed (haskell-indentation-check "fun = x" " ++ z" " ^")) (ert-deftest haskell-indentation-check-11 () "Guards with commas" (haskell-indentation-check "clunky env var1 var2" " | Just val1 <- lookup env var1" " , Just val2 <- lookup env var2" " ^")) (ert-deftest haskell-indentation-check-12 () "Guards with commas" :expected-result :failed (haskell-indentation-check "fun = do { putStrLn \"X\";" " }" " ^")) (ert-deftest haskell-indentation-check-13 () "Don't indent after deriving" :expected-result :failed (haskell-indentation-check "data X = X" " deriving (Eq, Ord, Show)" "^")) (ert-deftest haskell-indentation-check-14 () "Line starting with operator inside a 'do' needs to be indented" :expected-result :failed (haskell-indentation-check "fun = do" " pure X" " <*> marg" " ^")) (ert-deftest haskell-indentation-check-15 () "An if..then inside a do block" :expected-result :failed (haskell-indentation-check "fun = do" " if x" " then do" " putStrLn \"True\"" " ^")) (ert-deftest haskell-indentation-check-16 () "Lambda and a do block" :expected-result :failed (haskell-indentation-check "fun = \x -> do" " ^")) (ert-deftest haskell-indentation-check-16a () "A lambda" :expected-result :failed (haskell-indentation-check "fun = \x ->" " ^")) haskell-mode-13.14.2/tests/haskell-mode-tests.el000066400000000000000000000241541253441665600214420ustar00rootroot00000000000000;;; haskell-mode-tests.el --- ;; Copyright (c) 2014 Chris Done. All rights reserved. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: (require 'ert) (require 'haskell-mode) (ert-deftest empty () (should (with-temp-buffer (haskell-mode) (eq nil (haskell-ident-at-point))))) (ert-deftest empty-pos () (should (with-temp-buffer (haskell-mode) (eq nil (haskell-ident-pos-at-point))))) (ert-deftest empty-spanable () (should (with-temp-buffer (haskell-mode) (eq nil (haskell-spanable-pos-at-point))))) (ert-deftest aftercolons () (should (with-temp-buffer (haskell-mode) (insert "foo ::") (eq nil (haskell-ident-at-point))))) (ert-deftest aftercolons-pos () (should (with-temp-buffer (haskell-mode) (insert "foo ::") (eq nil (haskell-ident-pos-at-point))))) (ert-deftest beforetype () (should (with-temp-buffer (haskell-mode) (insert "foo ::") (save-excursion (insert " bar -> baz")) (eq nil (haskell-ident-at-point))))) (ert-deftest beforetype-pos () (should (with-temp-buffer (haskell-mode) (insert "foo ::") (save-excursion (insert " bar -> baz")) (eq nil (haskell-ident-pos-at-point))))) (ert-deftest beforetype-spanable () (should (with-temp-buffer (haskell-mode) (insert "foo ::") (save-excursion (insert " bar -> baz")) (eq nil (haskell-spanable-pos-at-point))))) (ert-deftest single () (should (with-temp-buffer (haskell-mode) (insert "a") (string= "a" (haskell-ident-at-point))))) (ert-deftest constructor () (should (with-temp-buffer (haskell-mode) (insert "Hello123") (string= "Hello123" (haskell-ident-at-point))))) (ert-deftest in-string () (should (with-temp-buffer (haskell-mode) (insert "\"Hello\"") (goto-char (1- (point-max))) (string= "Hello" (haskell-ident-at-point))))) (ert-deftest in-commas () (should (with-temp-buffer (haskell-mode) (insert ",Hello,") (goto-char (1- (point-max))) (string= "Hello" (haskell-ident-at-point))))) (ert-deftest var () (should (with-temp-buffer (haskell-mode) (insert "hello") (string= "hello" (haskell-ident-at-point))))) (ert-deftest prime () (should (with-temp-buffer (haskell-mode) (insert "f'") (string= "f'" (haskell-ident-at-point))))) (ert-deftest prime2 () (should (with-temp-buffer (haskell-mode) (insert "f5oo'") (string= "f5oo'" (haskell-ident-at-point))))) (ert-deftest prime3 () (should (with-temp-buffer (haskell-mode) (insert "f'oo'") (string= "f'oo'" (haskell-ident-at-point))))) (ert-deftest prime4 () (should (with-temp-buffer (haskell-mode) (insert "f'oo'") (goto-char (point-min)) (string= "f'oo'" (haskell-ident-at-point))))) (ert-deftest prime5 () (should (with-temp-buffer (haskell-mode) (insert "f'o6o'") (goto-char (+ 1 (point-min))) (string= "f'o6o'" (haskell-ident-at-point))))) (ert-deftest prime6 () (should (with-temp-buffer (haskell-mode) (insert "f'oo'") (goto-char (+ 2 (point-min))) (string= "f'oo'" (haskell-ident-at-point))))) (ert-deftest underscore () (should (with-temp-buffer (haskell-mode) (insert "f_oo_") (goto-char (+ 2 (point-min))) (string= "f_oo_" (haskell-ident-at-point))))) (ert-deftest underscore2 () (should (with-temp-buffer (haskell-mode) (insert "_oo_") (goto-char (point-min)) (string= "_oo_" (haskell-ident-at-point))))) (ert-deftest underscore3 () (should (with-temp-buffer (haskell-mode) (insert "o3o_") (string= "o3o_" (haskell-ident-at-point))))) (ert-deftest unicode () (should (with-temp-buffer (haskell-mode) (insert "åöèą5ċōïá") (string= "åöèą5ċōïá" (haskell-ident-at-point))))) (ert-deftest unicode2 () (should (with-temp-buffer (haskell-mode) (insert "Äöèąċōïá") (string= "Äöèąċōïá" (haskell-ident-at-point))))) (ert-deftest unicode-pos () (should (with-temp-buffer (haskell-mode) (insert "åöèą5ċōïá") (equal (cons (point-min) (point-max)) (haskell-ident-pos-at-point))))) (ert-deftest unicode2-pos () (should (with-temp-buffer (haskell-mode) (insert "Äöèąċōïá") (equal (cons (point-min) (point-max)) (haskell-ident-pos-at-point))))) (ert-deftest unicode-spanable () (should (with-temp-buffer (haskell-mode) (insert "åöèą5ċōïá") (equal (cons (point-min) (point-max)) (haskell-spanable-pos-at-point))))) (ert-deftest unicode2-spanable () (should (with-temp-buffer (haskell-mode) (insert "Äöèąċōïá") (equal (cons (point-min) (point-max)) (haskell-spanable-pos-at-point))))) (ert-deftest ident-in-backticks () (should (with-temp-buffer (haskell-mode) (insert "`foo`") (backward-char 2) (string= "foo" (haskell-ident-at-point))))) (ert-deftest ident-pos-in-backticks () (should (with-temp-buffer (haskell-mode) (insert "`foo`") (backward-char 2) (equal (cons (1+ (point-min)) (1- (point-max))) (haskell-ident-pos-at-point))))) (ert-deftest spanable-pos-in-backticks () (should (with-temp-buffer (haskell-mode) (insert "`foo`") (backward-char 2) (equal (cons (point-min) (point-max)) (haskell-spanable-pos-at-point))))) (defun check-fill (expected initial) "Check using ERT if `fill-paragraph' over `initial' gives `expected' result. Cursor fill be positioned at '@' character or at the beginning of the buffer. `fill-column' will be set to 10 so that it is easy to spot issues." (should (equal expected (with-temp-buffer (haskell-mode) (setq fill-column 10) (dolist (line initial) (insert line) (insert "\n")) (goto-char (point-min)) (skip-chars-forward "^@") (if (eobp) (goto-char (point-min)) (delete-char 1)) (fill-paragraph nil) (split-string (buffer-substring-no-properties (point-min) (1- (point-max))) "\n"))))) (ert-deftest fill-comment-1 () (check-fill '("{- a -}") '("{- @a -}"))) (ert-deftest fill-comment-2 () (check-fill '("{- a b c d e" "f g h i j" "k -}") '("{- @a b c d e f g h i j k -}"))) (ert-deftest fill-comment-3 () (check-fill '("{-" "a" "-}") '("{-" "@a" "-}"))) (ert-deftest fill-comment-4 () (check-fill '("{-" "a b c d e" "f g h i-}") '("{-" "@a" "b" "c" "d e f g h i-}"))) (ert-deftest fill-comment-5 () (check-fill '(" {-" " a b c d e" "f g h i" " -}") '(" {-" " @a b c d e f g h i" " -}"))) (ert-deftest fill-comment-6 () (check-fill '(" -- a b c" " -- d e f" " -- g h i" " -- j k l" " -- m n o" " -- p q r" " -- s t u" " -- v") '(" -- @a b c d e f g h i j k l m n o p q r s t u v"))) (ert-deftest fill-comment-7 () (check-fill '(" -- a b" " -- c d" " -- e f" " -- g h" " -- i j") '(" -- @a b c d e f g h i j "))) (ert-deftest fill-comment-8 () "Note: first letter of second line should be in the same column as first letter in the first line. Also should respect 10 column fill." :expected-result :failed (check-fill '(" {- a b" " c d" " e f" " g h" " i j" " -}") '(" {- @a b c d e f g h i j" " -}"))) (ert-deftest fill-comment-9 () "Note: first letter in the second line position should be kept as defined, just the content should move properly. Also should respect 10 column fill." :expected-result :failed (check-fill '(" {- a b" " c d e" " f g h" " i j" " -}") '(" {- @a" " b c d e f g h i j" " -}"))) (ert-deftest fill-comment-10 () "Note: first letter in the second line position should be kept as defined, just the content should move properly. Following lines should take position from second line. Also should respect 10 column fill." :expected-result :failed (check-fill '(" {- a b" " c d e" " f g h" " i j" " -}") '(" {- @a" " b c d e" " f g h" " i j" " -}"))) (ert-deftest fill-comment-11 () "Note: first letter in the second line position should be kept as defined, just the content should move properly. Also should respect 10 column fill." :expected-result :failed (check-fill '(" -- a b" " -- c d e" " -- f g h" " -- i j") '(" -- @a" " -- b c d e f g h i j"))) (ert-deftest fill-comment-12 () "Note: first letter in the second line position should be kept as defined, just the content should move properly. Following lines should take position from second line. Also should respect 10 column fill." :expected-result :failed (check-fill '(" -- a b" " -- c d e" " -- f g h" " -- i j") '(" -- @a" " -- b c d e" "--f g h" " -- i j"))) (provide 'haskell-mode-tests) haskell-mode-13.14.2/tests/haskell-process-tests.el000066400000000000000000000104021253441665600221630ustar00rootroot00000000000000;;; haskell-process-tests.el ;;; Code: (require 'ert) (require 'el-mock) (require 'haskell-process) (ert-deftest haskell-process-wrapper-command-function-identity () "No wrapper, return directly the command." (should (equal '("ghci") (progn (custom-set-variables '(haskell-process-wrapper-function #'identity)) (apply haskell-process-wrapper-function (list '("ghci"))))))) (ert-deftest haskell-process-wrapper-function-non-identity () "Wrapper as a string, return the wrapping command as a string." (should (equal '("nix-shell" "default.nix" "--command" "cabal\\ run") (progn (custom-set-variables '(haskell-process-wrapper-function (lambda (argv) (append '("nix-shell" "default.nix" "--command") (list (shell-quote-argument argv)))))) (apply haskell-process-wrapper-function (list "cabal run")))))) (ert-deftest test-haskell-process--compute-process-log-and-command-ghci () (should (equal '("Starting inferior GHCi process ghci ..." "dumses1" nil "ghci" "-ferror-spans") (let ((haskell-process-path-ghci "ghci") (haskell-process-args-ghci '("-ferror-spans"))) (custom-set-variables '(haskell-process-wrapper-function #'identity)) (mocklet (((haskell-session-name "dummy-session") => "dumses1")) (haskell-process-compute-process-log-and-command "dummy-session" 'ghci)))))) (ert-deftest test-haskell-process--with-wrapper-compute-process-log-and-command-ghci () (should (equal '("Starting inferior GHCi process ghci ..." "dumses1" nil "nix-shell" "default.nix" "--command" "ghci\\ -ferror-spans") (let ((haskell-process-path-ghci "ghci") (haskell-process-args-ghci '("-ferror-spans"))) (custom-set-variables '(haskell-process-wrapper-function (lambda (argv) (append (list "nix-shell" "default.nix" "--command" ) (list (shell-quote-argument (mapconcat 'identity argv " "))))))) (mocklet (((haskell-session-name "dummy-session") => "dumses1")) (haskell-process-compute-process-log-and-command "dummy-session" 'ghci)))))) (ert-deftest test-haskell-process--compute-process-log-and-command-cabal-repl () (should (equal '("Starting inferior `cabal repl' process using cabal ..." "dumses2" nil "cabal" "repl" "--ghc-option=-ferror-spans" "dumdum-session") (let ((haskell-process-path-cabal "cabal") (haskell-process-args-cabal-repl '("--ghc-option=-ferror-spans"))) (custom-set-variables '(haskell-process-wrapper-function #'identity)) (mocklet (((haskell-session-name "dummy-session2") => "dumses2") ((haskell-session-target "dummy-session2") => "dumdum-session")) (haskell-process-compute-process-log-and-command "dummy-session2" 'cabal-repl)))))) (ert-deftest test-haskell-process--with-wrapper-compute-process-log-and-command-cabal-repl () (should (equal '("Starting inferior `cabal repl' process using cabal ..." "dumses2" nil "nix-shell" "default.nix" "--command" "cabal\\ repl\\ --ghc-option\\=-ferror-spans\\ dumdum-session") (let ((haskell-process-path-cabal "cabal") (haskell-process-args-cabal-repl '("--ghc-option=-ferror-spans"))) (custom-set-variables '(haskell-process-wrapper-function (lambda (argv) (append (list "nix-shell" "default.nix" "--command" ) (list (shell-quote-argument (mapconcat 'identity argv " "))))))) (mocklet (((haskell-session-name "dummy-session2") => "dumses2") ((haskell-session-target "dummy-session2") => "dumdum-session")) (haskell-process-compute-process-log-and-command "dummy-session2" 'cabal-repl)))))) ;;; haskell-process-tests.el ends here haskell-mode-13.14.2/tests/haskell-simple-indent-tests.el000066400000000000000000000161141253441665600232630ustar00rootroot00000000000000(require 'ert) (require 'haskell-simple-indent) (defun find-indent-positions (lines-above-content) (with-temp-buffer (dolist (line lines-above-content) (insert line) (insert "\n")) ;; cursor is at the beginning of the second line now (let ((result '())) (dotimes (i 10) (haskell-simple-indent) (setq result (cons (current-column) result))) (reverse result)))) (defun find-indent-and-backtab-positions (lines-above-content &optional prepare-buffer) (with-temp-buffer (if prepare-buffer (funcall prepare-buffer)) (dolist (line lines-above-content) (insert line) (insert "\n")) ;; cursor is at the beginning of the second line now (let ((result-forward '(0)) (result-backward '())) (dotimes (i 9) (haskell-simple-indent) (setq result-forward (cons (current-column) result-forward))) (dotimes (i 9) (setq result-backward (cons (current-column) result-backward)) (haskell-simple-indent-backtab)) (setq result-backward (cons (current-column) result-backward)) (list (reverse result-forward) result-backward)))) (defun indent-and-backtab-last-line (lines &optional prepare-buffer) (with-temp-buffer (let (after-indent after-backtab) (if prepare-buffer (funcall prepare-buffer)) (dolist (line lines) (insert line) (insert "\n")) (forward-line -1) (skip-chars-forward "^|") (delete-char 1) (haskell-simple-indent) (insert "|") (setq after-indent (buffer-substring (line-beginning-position) (line-end-position))) (delete-char -1) (haskell-simple-indent-backtab) (insert "|") (setq after-backtab (buffer-substring (line-beginning-position) (line-end-position))) (list after-indent after-backtab)))) (ert-deftest find-indent-positions-1 () (should (equal '(5 7 10 19 26 32 40 48 56 64) (find-indent-positions '("main = do putStrLn \"Hello World!\""))))) (ert-deftest find-indent-positions-2 () (should (equal '(8 10 13 20 24 27 32 35 37 45) (find-indent-positions '("\tx <- return 123 {- This is a comment -}"))))) (ert-deftest find-indent-positions-3 () (should (equal '(2 4 6 8 10 12 14 16 24 32) (find-indent-positions '("a b c d" " e f g h"))))) (ert-deftest find-indent-positions-4 () (should (equal '(2 4 5 8 16 24 32 40 48 56) (find-indent-positions '("a b c d e f g h" " long_streak"))))) (ert-deftest find-indent-positions-5 () (should (equal '(2 4 6 13 15 17 19 24 32 40) (find-indent-positions '(" f g e e iirelevant" "a b c d" " h idden" " hidden" "" " e f g h" ""))))) (ert-deftest find-indent-and-backtab-positions-1 () (should (equal '((0 2 4 5 8 16 24 32 40 48) (0 2 4 5 8 16 24 32 40 48)) ;; Note: haskell-simple-indent-backtab is broken when ;; it encounters TABs in source file. (find-indent-and-backtab-positions '("a b c d e f g h" " long_streak") (lambda () (setq indent-tabs-mode nil)))))) (ert-deftest find-indent-and-backtab-positions-1a () (should (equal '((0 2 4 5 8 16 24 32 40 48) (0 2 4 5 8 16 24 32 40 48)) (find-indent-and-backtab-positions '("a b c d e f g h" " long_streak"))))) (ert-deftest find-indent-and-backtab-positions-2 () (should (equal '((0 8 10 13 20 24 27 32 35 37) (0 8 10 13 20 24 27 32 35 37)) (find-indent-and-backtab-positions '("\tx <- return 123 {- This is a comment -}") (lambda () (setq indent-tabs-mode nil)))))) (ert-deftest find-indent-and-backtab-positions-2a () (should (equal '((0 8 10 13 20 24 27 32 35 37) (0 8 10 13 20 24 27 32 35 37)) (find-indent-and-backtab-positions '("\tx <- return 123 {- This is a comment -}"))))) (ert-deftest find-indent-and-backtab-positions-3 () (should (equal '((0 2 4 6 13 15 17 19 24 32) (0 2 4 6 13 15 17 19 24 32)) (find-indent-and-backtab-positions '(" f g e e iirelevant" "a b c d" " h idden x" " hidden 4 5" "" " e f g h" "") (lambda () (setq indent-tabs-mode nil)))))) (ert-deftest find-indent-and-backtab-positions-3a () (should (equal '((0 2 4 6 13 15 17 19 24 32) (0 2 4 6 13 15 17 19 24 32)) (find-indent-and-backtab-positions '(" f g e e iirelevant" "a b c d" " h idden x" " hidden 4 5" "" " e f g h" ""))))) (ert-deftest indent-and-backtab-last-line-1 () (should (equal '("\t|" "|") (indent-and-backtab-last-line '("|"))))) (ert-deftest indent-and-backtab-last-line-2 () (should (equal '("\t|x" "|x") (indent-and-backtab-last-line '("|x"))))) (ert-deftest indent-and-backtab-last-line-3 () (should (equal '("\t|x" "|x") (indent-and-backtab-last-line '("| x"))))) (ert-deftest indent-and-backtab-last-line-4 () (should (equal '(" |x" " |x") (indent-and-backtab-last-line '("a b c" "| x"))))) (ert-deftest indent-and-backtab-last-line-5 () (should (equal '("\tx|y" "x|y") (indent-and-backtab-last-line '("x|y"))))) (ert-deftest indent-and-backtab-last-line-6 () (should (equal '("\t\t\tx|y" "x|y") (indent-and-backtab-last-line '("\t\t\tbase" "x|y"))))) (ert-deftest indent-and-backtab-last-line-7 () (should (equal '("\txy |" " xy |") (indent-and-backtab-last-line '(" p x" "\t\t\tbase" " xy |"))))) (ert-deftest indent-and-backtab-last-line-8 () (should (equal '("\t\t this_is_|long" "\t this_is_|long") (indent-and-backtab-last-line '(" a a a a a a a a this_is_long" " this_is_|long"))))) haskell-mode-13.14.2/tests/haskell-sort-imports-tests.el000066400000000000000000000071701253441665600231770ustar00rootroot00000000000000;;; haskell-sort-imports-tests.el --- Unit tests for haskell-sort-imports ;; Copyright (c) 2014 Chris Done. All rights reserved. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: (require 'ert) (require 'haskell-sort-imports) (ert-deftest empty-buffer () (should (with-temp-buffer (haskell-sort-imports) t))) (ert-deftest single-line () (should (with-temp-buffer (insert "import A\n") (goto-char (point-min)) (haskell-sort-imports) (string= (buffer-string) "import A\n")))) (ert-deftest two-idem () (should (with-temp-buffer (insert "import A import B ") (goto-char (point-min)) (haskell-sort-imports) (string= (buffer-string) "import A import B "))) (should (with-temp-buffer (insert "import qualified A import B ") (goto-char (point-min)) (haskell-sort-imports) (string= (buffer-string) "import qualified A import B "))) (should (with-temp-buffer (insert "import qualified \"mtl\" A import B ") (goto-char (point-min)) (haskell-sort-imports) (string= (buffer-string) "import qualified \"mtl\" A import B ")))) (ert-deftest two-rev () (should (with-temp-buffer (insert "import B import A ") (goto-char (point-min)) (haskell-sort-imports) (string= (buffer-string) "import A import B ")))) (ert-deftest file-structure () (should (with-temp-buffer (insert "module A where import B import A ") (goto-char (point-min)) (forward-line) (haskell-sort-imports) (string= (buffer-string) "module A where import A import B "))) (should (with-temp-buffer (insert "module C where import B import A ") (goto-char (point-min)) (forward-line 2) (haskell-sort-imports) (string= (buffer-string) "module C where import A import B ")))) (ert-deftest bos-270 () (should (with-temp-buffer (insert "import Data.Aeson.Encode (encode) import Data.Aeson.Types import Data.Aeson.Parser.Internal (decodeWith, decodeStrictWith, eitherDecodeWith, eitherDecodeStrictWith, jsonEOF, json, jsonEOF', json') import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L ") (goto-char (point-min)) (haskell-sort-imports) (string= (buffer-string) "import Data.Aeson.Encode (encode) import Data.Aeson.Parser.Internal (decodeWith, decodeStrictWith, eitherDecodeWith, eitherDecodeStrictWith, jsonEOF, json, jsonEOF', json') import Data.Aeson.Types import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L ")))) (provide 'haskell-sort-imports-tests) haskell-mode-13.14.2/tests/haskell-string-tests.el000066400000000000000000000107711253441665600220240ustar00rootroot00000000000000;; unit tests for haskell-string.el (require 'ert) (require 'haskell-string) ;; implementation under test (ert-deftest haskell-string-take () (should (string= (haskell-string-take "" 0) "")) (should (string= (haskell-string-take "" 1) "")) (should (string= (haskell-string-take "" 2) "")) (should (string= (haskell-string-take "x" 0) "")) (should (string= (haskell-string-take "x" 1) "x")) (should (string= (haskell-string-take "x" 2) "x")) (should (string= (haskell-string-take "x" 3) "x")) (should (string= (haskell-string-take "xy" 0) "")) (should (string= (haskell-string-take "xy" 1) "x")) (should (string= (haskell-string-take "xy" 2) "xy")) (should (string= (haskell-string-take "xy" 3) "xy")) (should (string= (haskell-string-take "xyz" 0) "")) (should (string= (haskell-string-take "xyz" 1) "x")) (should (string= (haskell-string-take "xyz" 2) "xy")) (should (string= (haskell-string-take "xyz" 3) "xyz")) (should (string= (haskell-string-take "xyz" 4) "xyz"))) (ert-deftest haskell-string-ellipsize () (should (string= (haskell-string-ellipsize "" 0) "")) (should (string= (haskell-string-ellipsize "" 1) "")) (should (string= (haskell-string-ellipsize "" 2) "")) (should (string= (haskell-string-ellipsize "x" 0) "")) (should (string= (haskell-string-ellipsize "x" 1) "x")) (should (string= (haskell-string-ellipsize "x" 2) "x")) (should (string= (haskell-string-ellipsize "x" 3) "x")) (should (string= (haskell-string-ellipsize "xy" 0) "")) (should (string= (haskell-string-ellipsize "xy" 1) "…")) (should (string= (haskell-string-ellipsize "xy" 2) "xy")) (should (string= (haskell-string-ellipsize "xy" 3) "xy")) (should (string= (haskell-string-ellipsize "xyz" 0) "")) (should (string= (haskell-string-ellipsize "xyz" 1) "…")) (should (string= (haskell-string-ellipsize "xyz" 2) "x…")) (should (string= (haskell-string-ellipsize "xyz" 3) "xyz")) (should (string= (haskell-string-ellipsize "xyz" 4) "xyz"))) (ert-deftest haskell-string-literal-encode-empty () (should (string= (haskell-string-literal-encode "") "\"\"")) (should (string= (haskell-string-literal-encode "" t) ""))) (ert-deftest haskell-string-literal-decode-empty () (dolist (s0 (list "\"\"" "\"\\&\"" "\"\\&\\&\\&\"" "\"\\ \\\"" "\"\\ \\\\ \\\"" "\"\\&\\ \\\"" "\"\\ \\\\&\\ \\\"")) (should (string= "" (haskell-string-literal-decode s0))) (should (string= "" (haskell-string-literal-decode (substring s0 1 -1) t))))) (ert-deftest haskell-string-literal-decode-backslash () "Test some edge cases involving backslashes." (dolist (cs (list (cons "\\\\" "\\") (cons "\\x10" "\x10") (cons "\\\\x10" "\\x10") (cons "\\ \\x10" "x10") (cons "\\ \\ \\x30" " 0") (cons "\\SO\\&H" "\x0eH") (cons "\\SOH\\&" "\x01") (cons "\\n" "\n") (cons "\\'" "'") (cons "\\\"" "\"") (cons "\\SOH" "\x01"))) (should (string= (cdr cs) (haskell-string-literal-decode (concat "\"" (car cs) "\"")))) (should (string= (cdr cs) (haskell-string-literal-decode (car cs) t))))) (defun haskell-string-random (n) "Generate random N characters long string." (let ((a ())) (apply #'string (dotimes (_ n a) (setq a (cons (random 1024) a)))))) (ert-deftest haskell-string-literal-decode-encode () "Test whether decode+encode is the identity function." (random "c7430a4") ;; some edge cases (dolist (s0 (list "\x0e\x48" ;; '\SO' 'H' "\x01" ;; '\SOH' "\x00df\x30" ;; '\223' '0' "'" "\'" "\"" "\x0e&H" "\\" " \\ \\" "\\\\\"" (string 40 945 8322 946 8323 8743 947 178 949 178 41) "x" "xy" "\\x123" "\\ \\x123" " " " " "")) (should (string= s0 (haskell-string-literal-decode (haskell-string-literal-encode s0)))) (should (string= s0 (haskell-string-literal-decode (haskell-string-literal-encode s0 t) t)))) ;; randomized testing (dotimes (_ 50) (dotimes (n 15) (let* ((s0 (haskell-string-random (+ 1 n))) (s1 (haskell-string-literal-decode (haskell-string-literal-encode s0))) (s2 (haskell-string-literal-decode (haskell-string-literal-encode s0 t) t))) (should (string= s0 s1)) (should (string= s0 s2)))))) haskell-mode-13.14.2/tests/haskell-utils-tests.el000066400000000000000000000060621253441665600216540ustar00rootroot00000000000000(require 'ert) (require 'haskell-utils) (defun insert-lines (&rest lines) (dolist (line lines) (insert (concat line "\n")))) (ert-deftest simple-import-parse () (should (equal "A.B.C" (with-temp-buffer (insert-lines "import A.B.C") (goto-char (point-min)) (forward-line 0) (haskell-utils-parse-import-statement-at-point))))) (ert-deftest qualified-import-parse () (should (equal "A.B.C" (with-temp-buffer (insert-lines "import qualified A.B.C") (goto-char (point-min)) (forward-line 0) (haskell-utils-parse-import-statement-at-point))))) (ert-deftest qualified-as-import-parse () (should (equal "AAA.Bc.Cx" (with-temp-buffer (insert-lines "import qualified AAA.Bc.Cx as Something") (goto-char (point-min)) (forward-line 0) (haskell-utils-parse-import-statement-at-point))))) (ert-deftest international-characters-import-parse () (should (equal "Żółć" (with-temp-buffer (insert-lines "import Żółć") (goto-char (point-min)) (forward-line 0) (haskell-utils-parse-import-statement-at-point))))) (ert-deftest commented-out-import-parse () (should (equal nil (with-temp-buffer (insert-lines "-- import Nothing") (goto-char (point-min)) (forward-line 0) (haskell-utils-parse-import-statement-at-point))))) (ert-deftest non-import-import-parse () (should (equal nil (with-temp-buffer (insert-lines "something import Nothing") (goto-char (point-min)) (forward-line 0) (haskell-utils-parse-import-statement-at-point))))) (ert-deftest many-spaces-import-parse () (should (equal "M" (with-temp-buffer (insert-lines "\t import\t qualified \t\tM\tas G") (goto-char (point-min)) (forward-line 0) (haskell-utils-parse-import-statement-at-point))))) (ert-deftest using-underscores-import-parse () (should (equal "Module_1.S_3_3_" (with-temp-buffer (insert-lines "import Module_1.S_3_3_") (goto-char (point-min)) (forward-line 0) (haskell-utils-parse-import-statement-at-point))))) (ert-deftest slightly-malformed-import-parse () (should (equal "q.Module...qwerqwe..." (with-temp-buffer (insert-lines "import q.Module...qwerqwe...") (goto-char (point-min)) (forward-line 0) (haskell-utils-parse-import-statement-at-point))))) (ert-deftest package-import-parse () (should (equal "B" (with-temp-buffer (insert-lines "import \"package-1.2.3\" B") (goto-char (point-min)) (forward-line 0) (haskell-utils-parse-import-statement-at-point))))) (ert-deftest safe-haskell-import-parse () (should (equal "B" (with-temp-buffer (insert-lines "import safe B") (goto-char (point-min)) (forward-line 0) (haskell-utils-parse-import-statement-at-point))))) (ert-deftest full-import-parse () (should (equal "Data.Char.Unicode_v_7" (with-temp-buffer (insert-lines "import safe qualified \"unicode-7.0\" Data.Char.Unicode_v_7 as U (func)") (goto-char (point-min)) (forward-line 0) (haskell-utils-parse-import-statement-at-point))))) haskell-mode-13.14.2/w3m-haddock.el000066400000000000000000000146661253441665600167030ustar00rootroot00000000000000;;; w3m-haddock.el --- Make browsing haddocks with w3m-mode better. ;; Copyright (C) 2014 Chris Done ;; Author: Chris Done ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. (require 'cl-lib) (require 'haskell-mode) (require 'haskell-font-lock) (declare-function w3m-buffer-title "w3m") (declare-function w3m-browse-url "w3m") (defvar w3m-current-url) (add-hook 'w3m-display-hook 'w3m-haddock-display) (defface w3m-haddock-heading-face '((((class color)) :inherit magit-item-highlight)) "Face for quarantines." :group 'shm) (defcustom haskell-w3m-haddock-dirs '("~/.cabal/share/doc/") "The path to your cabal documentation dir. It should contain directories of package-name-x.x. You can rebind this if you're using hsenv by adding it to your .dir-locals.el in your project root. E.g. ((haskell-mode . ((haskell-w3m-haddock-dirs . (\"/home/chris/Projects/foobar/.hsenv/cabal/share/doc\"))))) " :group 'shm :type 'list) (defvar w3m-haddock-entry-regex "^\\(\\(data\\|type\\) \\|[a-z].* :: \\)" "Regex to match entry headings.") (defun haskell-w3m-open-haddock () "Open a haddock page in w3m." (interactive) (let* ((entries (cl-remove-if (lambda (s) (string= s "")) (apply 'append (mapcar (lambda (dir) (split-string (shell-command-to-string (concat "ls -1 " dir)) "\n")) haskell-w3m-haddock-dirs)))) (package-dir (ido-completing-read "Package: " entries))) (cond ((member package-dir entries) (unless (cl-loop for dir in haskell-w3m-haddock-dirs when (w3m-haddock-find-index dir package-dir) do (progn (w3m-browse-url (w3m-haddock-find-index dir package-dir) t) (cl-return t))) (w3m-browse-url (concat "http://hackage.haskell.org/package/" package-dir) t))) (t (w3m-browse-url (concat "http://hackage.haskell.org/package/" package-dir) t))))) (defun w3m-haddock-find-index (dir package) (let ((html-index (concat dir "/" package "/html/index.html")) (index (concat dir "/" package "/index.html"))) (cond ((file-exists-p html-index) html-index) ((file-exists-p index) index)))) (defun w3m-haddock-page-p () "Haddock general page?" (save-excursion (goto-char (point-max)) (forward-line -2) (looking-at "[ ]*Produced by Haddock"))) (defun w3m-haddock-source-p () "Haddock source page?" (save-excursion (goto-char (point-min)) (or (looking-at "Location: https?://hackage.haskell.org/package/.*/docs/src/") (looking-at "Location: file://.*cabal/share/doc/.*/html/src/") (looking-at "Location: .*src/.*.html$")))) (defun w3m-haddock-p () "Any haddock page?" (or (w3m-haddock-page-p) (w3m-haddock-source-p))) (defun w3m-haddock-find-tag () "Find a tag by jumping to the \"All\" index and doing a search-forward." (interactive) (when (w3m-haddock-p) (let ((ident (haskell-ident-at-point))) (when ident (w3m-browse-url (replace-regexp-in-string "docs/.*" "docs/doc-index-All.html" w3m-current-url)) (search-forward ident))))) (defun w3m-haddock-display (url) "To be ran by w3m's display hook. This takes a normal w3m buffer containing hadddock documentation and reformats it to be more usable and look like a dedicated documentation page." (when (w3m-haddock-page-p) (save-excursion (goto-char (point-min)) (let ((inhibit-read-only t)) (delete-region (point) (line-end-position)) (w3m-haddock-next-heading) ;; Start formatting entries (while (looking-at w3m-haddock-entry-regex) (when (w3m-haddock-valid-heading) (w3m-haddock-format-heading)) (w3m-haddock-next-heading)))) (rename-buffer (concat "*haddock: " (w3m-buffer-title (current-buffer)) "*"))) (when (w3m-haddock-source-p) (font-lock-mode -1) (let ((n (line-number-at-pos))) (save-excursion (goto-char (point-min)) (forward-line 1) (let ((text (buffer-substring (point) (point-max))) (inhibit-read-only t)) (delete-region (point) (point-max)) (insert (haskell-fontify-as-mode text 'haskell-mode)))) (goto-char (point-min)) (forward-line (1- n))))) (defun w3m-haddock-format-heading () "Format a haddock entry." (let ((o (make-overlay (line-beginning-position) (1- (save-excursion (w3m-haddock-header-end)))))) (overlay-put o 'face 'w3m-haddock-heading-face)) (let ((end (save-excursion (w3m-haddock-next-heading) (when (w3m-haddock-valid-heading) (point))))) (when end (save-excursion (w3m-haddock-header-end) (indent-rigidly (point) end 4))))) (defun w3m-haddock-next-heading () "Go to the next heading, or end of the buffer." (forward-line 1) (or (search-forward-regexp w3m-haddock-entry-regex nil t 1) (goto-char (point-max))) (goto-char (line-beginning-position))) (defun w3m-haddock-valid-heading () "Is this a valid heading?" (not (get-text-property (point) 'face))) (defun w3m-haddock-header-end () "Go to the end of the header." (search-forward-regexp "\n[ \n]")) (provide 'w3m-haddock)