1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853
|
;;; haskell-doc.el --- show function types in echo area -*- coding: utf-8; lexical-binding: t -*-
;; Copyright © 2004, 2005, 2006, 2007, 2009, 2016 Free Software Foundation, Inc.
;; Copyright © 1997 Hans-Wolfgang Loidl
;; 2016 Arthur Fayzrakhmanov
;; Author: Hans-Wolfgang Loidl <hwloidl@dcs.glasgow.ac.uk>
;; Temporary Maintainer and Hacker: Graeme E Moss <gem@cs.york.ac.uk>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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.31 2015/07/23 10:34:20 ankhers
;; (turn-on-haskell-doc-mode): marked obsolete
;; (turn-on-haskell-doc): marked obsolete
;; other packages have been moving away from (turn-on-haskell-*)
;;
;; 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ä <scop@xemacs.org>, 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 <alauo@mip.sdu.dk>
;;
;; 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ä <scop@xemacs.org>.
;;
;; 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:
(require 'haskell-mode)
(require 'haskell-process)
(require 'haskell)
(require 'haskell-utils)
(require 'inf-haskell)
(require 'imenu)
(require 'eldoc)
;;;###autoload
(defgroup haskell-doc nil
"Show Haskell function types in echo area."
:group 'haskell
:prefix "haskell-doc-")
(defvar-local 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.")
(defvar haskell-doc-mode-hook nil
"Hook invoked when entering `haskell-doc-mode'.")
(defvar-local 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.")
(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.")
(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 in which 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.")
(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 [ , ] )")
("family" . "(type family type [kind] [= type_fam_equations]) | (data family type [kind])"))
"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.")
(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 "</tt>")
;; Some of the blocks of code are split.
(while (looking-at "\\(<[^<>]+>[ \t\n]*\\)*<tt>")
(goto-char (match-end 0))
(search-forward "</tt>"))
(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 "<br>" 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 (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 (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 "</table>")
(delete-region (point) (point-max))
(goto-char (point-min))
(let ((libs (list "standard-prelude.html")))
(while (re-search-forward "<a href=\"\\([^\"]+\\)\">" 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.")
(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.")
(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) )
;; 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)))))
(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))
(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))) )
(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)))
(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))
(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))
(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))
(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))
;;;###autoload
(defalias 'turn-on-haskell-doc-mode 'haskell-doc-mode)
(make-obsolete 'turn-on-haskell-doc-mode
'haskell-doc-mode
"2015-07-23")
;;;###autoload
(defalias 'turn-on-haskell-doc 'haskell-doc-mode)
(make-obsolete 'turn-on-haskell-doc
'haskell-doc-mode
"2015-07-23")
(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))
(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\)"))))
;; 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
(haskell-doc-in-code-p)
(not haskell-mode-interactive-prompt-state)
(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)))
;; not in string or comment
;; 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.
(when (haskell-doc-in-code-p)
(let ((msg (or
(haskell-doc-current-info--interaction)
(haskell-doc-sym-doc (haskell-ident-at-point)))))
(unless (symbolp msg) msg))))
(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)))
(defun haskell-doc-in-code-p ()
"A predicate indicating suitable case to show docs."
(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 or given symbol SYM.
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.
(let ((message-log-max nil))
(message "%s" doc))))))
(defvar haskell-doc-current-info--interaction-last nil
"Async message stack.
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.
(when (haskell-doc-in-code-p)
;; do nothing when inside string or comment
(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)))
(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 given symbol SYM.
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)))
(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)))
;; ToDo: handle open brackets to decide if it's a wrapped type
(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))))
(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)))
(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)))
(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))
(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)))))
(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)))
;; ToDo:
;; - modular way of defining a mapping of module name to file
;; - use a path to search for file (not just current directory)
(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")
(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)))
(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
(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)) )
(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 ))))
(provide 'haskell-doc)
;;; haskell-doc.el ends here
|