hoogle 4.0.0.3 → 4.0.0.5
raw patch · 80 files changed
+1553/−1026 lines, 80 filesdep +bytestringdep +timedep ~basebinary-added
Dependencies added: bytestring, time
Dependency ranges changed: base
Files
- LICENSE +0/−340
- database/array.hoo binary
- database/base.hoo binary
- database/bytestring.hoo binary
- database/cabal.hoo binary
- database/containers.hoo binary
- database/default.hoo too large to diff
- database/directory.hoo binary
- database/filepath.hoo binary
- database/ghc.hoo binary
- database/hackage.hoo binary
- database/haskell-src.hoo binary
- database/hunit.hoo binary
- database/keyword.hoo binary
- database/mtl.hoo binary
- database/parallel.hoo binary
- database/parsec.hoo binary
- database/pretty.hoo binary
- database/process.hoo binary
- database/quickcheck.hoo binary
- database/random.hoo binary
- database/stm.hoo binary
- database/template-haskell.hoo binary
- database/time.hoo binary
- database/xhtml.hoo binary
- default.hoo too large to diff
- docs/LICENSE +340/−0
- hoogle.cabal +117/−83
- src/CmdLine/Action.hs +15/−2
- src/CmdLine/Files.hs +19/−12
- src/CmdLine/Flag.hs +9/−2
- src/CmdLine/Query.hs +1/−1
- src/CmdLine/Search.hs +14/−3
- src/CmdLine/Test.hs +4/−1
- src/Data/Binary/Defer/Chunk.hs +0/−51
- src/Data/Binary/Defer/Class.hs +27/−5
- src/Data/Binary/Defer/Graph.hs +0/−136
- src/Data/Binary/Defer/Index.hs +5/−1
- src/Data/Binary/Defer/Monad.hs +138/−22
- src/Data/Binary/Defer/Trie.hs +25/−1
- src/Data/Binary/Raw.hs +2/−1
- src/General/Code.hs +1/−1
- src/General/Util.hs +15/−0
- src/Hoogle/All.hs +3/−2
- src/Hoogle/DataBase/Aliases.hs +16/−8
- src/Hoogle/DataBase/All.hs +26/−8
- src/Hoogle/DataBase/Instances.hs +12/−5
- src/Hoogle/DataBase/Items.hs +62/−45
- src/Hoogle/DataBase/NameSearch.hs +169/−75
- src/Hoogle/DataBase/Serialise.hs +11/−6
- src/Hoogle/DataBase/Suggest.hs +60/−29
- src/Hoogle/DataBase/Type.hs +2/−3
- src/Hoogle/DataBase/TypeSearch/All.hs +2/−2
- src/Hoogle/DataBase/TypeSearch/Binding.hs +3/−1
- src/Hoogle/DataBase/TypeSearch/Cost.hs +2/−0
- src/Hoogle/DataBase/TypeSearch/Graph.hs +0/−2
- src/Hoogle/DataBase/TypeSearch/Result.hs +3/−2
- src/Hoogle/DataBase/TypeSearch/TypeScore.hs +6/−2
- src/Hoogle/Item/All.hs +3/−1
- src/Hoogle/Item/Haddock.hs +8/−5
- src/Hoogle/Item/Item.hs +29/−14
- src/Hoogle/Item/URL.hs +34/−0
- src/Hoogle/Operations/All.hs +2/−0
- src/Hoogle/Operations/Combine.hs +11/−0
- src/Hoogle/Operations/Convert.hs +4/−3
- src/Hoogle/Operations/Rank.hs +2/−2
- src/Hoogle/Query/Parser.hs +20/−17
- src/Hoogle/Query/Render.hs +4/−1
- src/Hoogle/Query/Suggest.hs +38/−4
- src/Hoogle/Query/Type.hs +3/−18
- src/Hoogle/Search/Results.hs +5/−5
- src/Hoogle/TextBase/Parser.hs +1/−2
- src/Hoogle/TextBase/Type.hs +29/−1
- src/Hoogle/TypeSig/Parser.hs +6/−4
- src/Hoogle/TypeSig/Type.hs +18/−3
- src/Test/Parse_Query.hs +26/−17
- src/Test/Parse_TypeSig.hs +1/−0
- src/Web/Action.hs +80/−65
- src/Web/Page.hs +46/−12
- src/Web/Text.hs +74/−0
− LICENSE
@@ -1,340 +0,0 @@- GNU GENERAL PUBLIC LICENSE- Version 2, June 1991-- Copyright (C) 1989, 1991 Free Software Foundation, Inc.- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA- Everyone is permitted to copy and distribute verbatim copies- of this license document, but changing it is not allowed.-- Preamble-- The licenses for most software are designed to take away your-freedom to share and change it. By contrast, the GNU General Public-License is intended to guarantee your freedom to share and change free-software--to make sure the software is free for all its users. This-General Public License applies to most of the Free Software-Foundation's software and to any other program whose authors commit to-using it. (Some other Free Software Foundation software is covered by-the GNU Library General Public License instead.) You can apply it to-your programs, too.-- When we speak of free software, we are referring to freedom, not-price. Our General Public Licenses are designed to make sure that you-have the freedom to distribute copies of free software (and charge for-this service if you wish), that you receive source code or can get it-if you want it, that you can change the software or use pieces of it-in new free programs; and that you know you can do these things.-- To protect your rights, we need to make restrictions that forbid-anyone to deny you these rights or to ask you to surrender the rights.-These restrictions translate to certain responsibilities for you if you-distribute copies of the software, or if you modify it.-- For example, if you distribute copies of such a program, whether-gratis or for a fee, you must give the recipients all the rights that-you have. You must make sure that they, too, receive or can get the-source code. And you must show them these terms so they know their-rights.-- We protect your rights with two steps: (1) copyright the software, and-(2) offer you this license which gives you legal permission to copy,-distribute and/or modify the software.-- Also, for each author's protection and ours, we want to make certain-that everyone understands that there is no warranty for this free-software. If the software is modified by someone else and passed on, we-want its recipients to know that what they have is not the original, so-that any problems introduced by others will not reflect on the original-authors' reputations.-- Finally, any free program is threatened constantly by software-patents. We wish to avoid the danger that redistributors of a free-program will individually obtain patent licenses, in effect making the-program proprietary. To prevent this, we have made it clear that any-patent must be licensed for everyone's free use or not licensed at all.-- The precise terms and conditions for copying, distribution and-modification follow.-- GNU GENERAL PUBLIC LICENSE- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION-- 0. This License applies to any program or other work which contains-a notice placed by the copyright holder saying it may be distributed-under the terms of this General Public License. The "Program", below,-refers to any such program or work, and a "work based on the Program"-means either the Program or any derivative work under copyright law:-that is to say, a work containing the Program or a portion of it,-either verbatim or with modifications and/or translated into another-language. (Hereinafter, translation is included without limitation in-the term "modification".) Each licensee is addressed as "you".--Activities other than copying, distribution and modification are not-covered by this License; they are outside its scope. The act of-running the Program is not restricted, and the output from the Program-is covered only if its contents constitute a work based on the-Program (independent of having been made by running the Program).-Whether that is true depends on what the Program does.-- 1. You may copy and distribute verbatim copies of the Program's-source code as you receive it, in any medium, provided that you-conspicuously and appropriately publish on each copy an appropriate-copyright notice and disclaimer of warranty; keep intact all the-notices that refer to this License and to the absence of any warranty;-and give any other recipients of the Program a copy of this License-along with the Program.--You may charge a fee for the physical act of transferring a copy, and-you may at your option offer warranty protection in exchange for a fee.-- 2. You may modify your copy or copies of the Program or any portion-of it, thus forming a work based on the Program, and copy and-distribute such modifications or work under the terms of Section 1-above, provided that you also meet all of these conditions:-- a) You must cause the modified files to carry prominent notices- stating that you changed the files and the date of any change.-- b) You must cause any work that you distribute or publish, that in- whole or in part contains or is derived from the Program or any- part thereof, to be licensed as a whole at no charge to all third- parties under the terms of this License.-- c) If the modified program normally reads commands interactively- when run, you must cause it, when started running for such- interactive use in the most ordinary way, to print or display an- announcement including an appropriate copyright notice and a- notice that there is no warranty (or else, saying that you provide- a warranty) and that users may redistribute the program under- these conditions, and telling the user how to view a copy of this- License. (Exception: if the Program itself is interactive but- does not normally print such an announcement, your work based on- the Program is not required to print an announcement.)--These requirements apply to the modified work as a whole. If-identifiable sections of that work are not derived from the Program,-and can be reasonably considered independent and separate works in-themselves, then this License, and its terms, do not apply to those-sections when you distribute them as separate works. But when you-distribute the same sections as part of a whole which is a work based-on the Program, the distribution of the whole must be on the terms of-this License, whose permissions for other licensees extend to the-entire whole, and thus to each and every part regardless of who wrote it.--Thus, it is not the intent of this section to claim rights or contest-your rights to work written entirely by you; rather, the intent is to-exercise the right to control the distribution of derivative or-collective works based on the Program.--In addition, mere aggregation of another work not based on the Program-with the Program (or with a work based on the Program) on a volume of-a storage or distribution medium does not bring the other work under-the scope of this License.-- 3. You may copy and distribute the Program (or a work based on it,-under Section 2) in object code or executable form under the terms of-Sections 1 and 2 above provided that you also do one of the following:-- a) Accompany it with the complete corresponding machine-readable- source code, which must be distributed under the terms of Sections- 1 and 2 above on a medium customarily used for software interchange; or,-- b) Accompany it with a written offer, valid for at least three- years, to give any third party, for a charge no more than your- cost of physically performing source distribution, a complete- machine-readable copy of the corresponding source code, to be- distributed under the terms of Sections 1 and 2 above on a medium- customarily used for software interchange; or,-- c) Accompany it with the information you received as to the offer- to distribute corresponding source code. (This alternative is- allowed only for noncommercial distribution and only if you- received the program in object code or executable form with such- an offer, in accord with Subsection b above.)--The source code for a work means the preferred form of the work for-making modifications to it. For an executable work, complete source-code means all the source code for all modules it contains, plus any-associated interface definition files, plus the scripts used to-control compilation and installation of the executable. However, as a-special exception, the source code distributed need not include-anything that is normally distributed (in either source or binary-form) with the major components (compiler, kernel, and so on) of the-operating system on which the executable runs, unless that component-itself accompanies the executable.--If distribution of executable or object code is made by offering-access to copy from a designated place, then offering equivalent-access to copy the source code from the same place counts as-distribution of the source code, even though third parties are not-compelled to copy the source along with the object code.-- 4. You may not copy, modify, sublicense, or distribute the Program-except as expressly provided under this License. Any attempt-otherwise to copy, modify, sublicense or distribute the Program is-void, and will automatically terminate your rights under this License.-However, parties who have received copies, or rights, from you under-this License will not have their licenses terminated so long as such-parties remain in full compliance.-- 5. You are not required to accept this License, since you have not-signed it. However, nothing else grants you permission to modify or-distribute the Program or its derivative works. These actions are-prohibited by law if you do not accept this License. Therefore, by-modifying or distributing the Program (or any work based on the-Program), you indicate your acceptance of this License to do so, and-all its terms and conditions for copying, distributing or modifying-the Program or works based on it.-- 6. Each time you redistribute the Program (or any work based on the-Program), the recipient automatically receives a license from the-original licensor to copy, distribute or modify the Program subject to-these terms and conditions. You may not impose any further-restrictions on the recipients' exercise of the rights granted herein.-You are not responsible for enforcing compliance by third parties to-this License.-- 7. If, as a consequence of a court judgment or allegation of patent-infringement or for any other reason (not limited to patent issues),-conditions are imposed on you (whether by court order, agreement or-otherwise) that contradict the conditions of this License, they do not-excuse you from the conditions of this License. If you cannot-distribute so as to satisfy simultaneously your obligations under this-License and any other pertinent obligations, then as a consequence you-may not distribute the Program at all. For example, if a patent-license would not permit royalty-free redistribution of the Program by-all those who receive copies directly or indirectly through you, then-the only way you could satisfy both it and this License would be to-refrain entirely from distribution of the Program.--If any portion of this section is held invalid or unenforceable under-any particular circumstance, the balance of the section is intended to-apply and the section as a whole is intended to apply in other-circumstances.--It is not the purpose of this section to induce you to infringe any-patents or other property right claims or to contest validity of any-such claims; this section has the sole purpose of protecting the-integrity of the free software distribution system, which is-implemented by public license practices. Many people have made-generous contributions to the wide range of software distributed-through that system in reliance on consistent application of that-system; it is up to the author/donor to decide if he or she is willing-to distribute software through any other system and a licensee cannot-impose that choice.--This section is intended to make thoroughly clear what is believed to-be a consequence of the rest of this License.-- 8. If the distribution and/or use of the Program is restricted in-certain countries either by patents or by copyrighted interfaces, the-original copyright holder who places the Program under this License-may add an explicit geographical distribution limitation excluding-those countries, so that distribution is permitted only in or among-countries not thus excluded. In such case, this License incorporates-the limitation as if written in the body of this License.-- 9. The Free Software Foundation may publish revised and/or new versions-of the General Public License from time to time. Such new versions will-be similar in spirit to the present version, but may differ in detail to-address new problems or concerns.--Each version is given a distinguishing version number. If the Program-specifies a version number of this License which applies to it and "any-later version", you have the option of following the terms and conditions-either of that version or of any later version published by the Free-Software Foundation. If the Program does not specify a version number of-this License, you may choose any version ever published by the Free Software-Foundation.-- 10. If you wish to incorporate parts of the Program into other free-programs whose distribution conditions are different, write to the author-to ask for permission. For software which is copyrighted by the Free-Software Foundation, write to the Free Software Foundation; we sometimes-make exceptions for this. Our decision will be guided by the two goals-of preserving the free status of all derivatives of our free software and-of promoting the sharing and reuse of software generally.-- NO WARRANTY-- 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY-FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS-TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE-PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,-REPAIR OR CORRECTION.-- 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED-TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY-YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE-POSSIBILITY OF SUCH DAMAGES.-- END OF TERMS AND CONDITIONS-- How to Apply These Terms to Your New Programs-- If you develop a new program, and you want it to be of the greatest-possible use to the public, the best way to achieve this is to make it-free software which everyone can redistribute and change under these terms.-- To do so, attach the following notices to the program. It is safest-to attach them to the start of each source file to most effectively-convey the exclusion of warranty; and each file should have at least-the "copyright" line and a pointer to where the full notice is found.-- <one line to give the program's name and a brief idea of what it does.>- Copyright (C) <year> <name of author>-- 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, write to the Free Software- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA---Also add information on how to contact you by electronic and paper mail.--If the program is interactive, make it output a short notice like this-when it starts in an interactive mode:-- Gnomovision version 69, Copyright (C) year name of author- Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.- This is free software, and you are welcome to redistribute it- under certain conditions; type `show c' for details.--The hypothetical commands `show w' and `show c' should show the appropriate-parts of the General Public License. Of course, the commands you use may-be called something other than `show w' and `show c'; they could even be-mouse-clicks or menu items--whatever suits your program.--You should also get your employer (if you work as a programmer) or your-school, if any, to sign a "copyright disclaimer" for the program, if-necessary. Here is a sample; alter the names:-- Yoyodyne, Inc., hereby disclaims all copyright interest in the program- `Gnomovision' (which makes passes at compilers) written by James Hacker.-- <signature of Ty Coon>, 1 April 1989- Ty Coon, President of Vice--This General Public License does not permit incorporating your program into-proprietary programs. If your program is a subroutine library, you may-consider it more useful to permit linking proprietary applications with the-library. If this is what you want to do, use the GNU Library General-Public License instead of this License.
+ database/array.hoo view
binary file changed (absent → 83122 bytes)
+ database/base.hoo view
binary file changed (absent → 590378 bytes)
+ database/bytestring.hoo view
binary file changed (absent → 183341 bytes)
+ database/cabal.hoo view
binary file changed (absent → 376830 bytes)
+ database/containers.hoo view
binary file changed (absent → 143415 bytes)
+ database/default.hoo view
file too large to diff
+ database/directory.hoo view
binary file changed (absent → 51298 bytes)
+ database/filepath.hoo view
binary file changed (absent → 67927 bytes)
+ database/ghc.hoo view
binary file changed (absent → 312693 bytes)
+ database/hackage.hoo view
binary file changed (absent → 323754 bytes)
+ database/haskell-src.hoo view
binary file changed (absent → 109354 bytes)
+ database/hunit.hoo view
binary file changed (absent → 42432 bytes)
+ database/keyword.hoo view
binary file changed (absent → 19866 bytes)
+ database/mtl.hoo view
binary file changed (absent → 79491 bytes)
+ database/parallel.hoo view
binary file changed (absent → 48371 bytes)
+ database/parsec.hoo view
binary file changed (absent → 195681 bytes)
+ database/pretty.hoo view
binary file changed (absent → 43710 bytes)
+ database/process.hoo view
binary file changed (absent → 41534 bytes)
+ database/quickcheck.hoo view
binary file changed (absent → 48732 bytes)
+ database/random.hoo view
binary file changed (absent → 36518 bytes)
+ database/stm.hoo view
binary file changed (absent → 39852 bytes)
+ database/template-haskell.hoo view
binary file changed (absent → 128618 bytes)
+ database/time.hoo view
binary file changed (absent → 73485 bytes)
+ database/xhtml.hoo view
binary file changed (absent → 114776 bytes)
− default.hoo
file too large to diff
+ docs/LICENSE view
@@ -0,0 +1,340 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users. This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it. (Some other Free Software Foundation software is covered by+the GNU Library General Public License instead.) You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++ To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. You must make sure that they, too, receive or can get the+source code. And you must show them these terms so they know their+rights.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ GNU GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License. The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language. (Hereinafter, translation is included without limitation in+the term "modification".) Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++ 1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++ 2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) You must cause the modified files to carry prominent notices+ stating that you changed the files and the date of any change.++ b) You must cause any work that you distribute or publish, that in+ whole or in part contains or is derived from the Program or any+ part thereof, to be licensed as a whole at no charge to all third+ parties under the terms of this License.++ c) If the modified program normally reads commands interactively+ when run, you must cause it, when started running for such+ interactive use in the most ordinary way, to print or display an+ announcement including an appropriate copyright notice and a+ notice that there is no warranty (or else, saying that you provide+ a warranty) and that users may redistribute the program under+ these conditions, and telling the user how to view a copy of this+ License. (Exception: if the Program itself is interactive but+ does not normally print such an announcement, your work based on+ the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++ a) Accompany it with the complete corresponding machine-readable+ source code, which must be distributed under the terms of Sections+ 1 and 2 above on a medium customarily used for software interchange; or,++ b) Accompany it with a written offer, valid for at least three+ years, to give any third party, for a charge no more than your+ cost of physically performing source distribution, a complete+ machine-readable copy of the corresponding source code, to be+ distributed under the terms of Sections 1 and 2 above on a medium+ customarily used for software interchange; or,++ c) Accompany it with the information you received as to the offer+ to distribute corresponding source code. (This alternative is+ allowed only for noncommercial distribution and only if you+ received the program in object code or executable form with such+ an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++ 4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++ 5. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++ 6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++ 7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++ 9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number. If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++ 10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++ NO WARRANTY++ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ 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, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) year name of author+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs. If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library. If this is what you want to do, use the GNU Library General+Public License instead of this License.
hoogle.cabal view
@@ -1,9 +1,9 @@-cabal-version: >= 1.1.4+cabal-version: >= 1.2 build-type: Simple name: hoogle-version: 4.0.0.3+version: 4.0.0.5 license: GPL-license-file: LICENSE+license-file: docs/LICENSE category: Development author: Neil Mitchell <ndmitchell@gmail.com> maintainer: Neil Mitchell <ndmitchell@gmail.com>@@ -15,85 +15,119 @@ or by approximate type signature. homepage: http://www.haskell.org/hoogle/ stability: Beta-build-depends: base, parsec, filepath, directory, process, safe, containers, uniplate, mtl, array extra-source-files: README.txt-data-files: default.hoo+data-dir: database+data-files:+ array.hoo+ base.hoo+ bytestring.hoo+ cabal.hoo+ containers.hoo+ default.hoo+ directory.hoo+ filepath.hoo+ ghc.hoo+ hackage.hoo+ haskell-src.hoo+ hunit.hoo+ keyword.hoo+ mtl.hoo+ parallel.hoo+ parsec.hoo+ pretty.hoo+ process.hoo+ quickcheck.hoo+ random.hoo+ stm.hoo+ template-haskell.hoo+ time.hoo+ xhtml.hoo -executable: hoogle-main-is: Main.hs-hs-source-dirs: src-other-modules:- CmdLine.Action- CmdLine.All- CmdLine.Files- CmdLine.Flag- CmdLine.Query- CmdLine.Search- CmdLine.Test- Data.Binary.Defer- Data.Binary.Defer.Array- Data.Binary.Defer.Chunk- Data.Binary.Defer.Class- Data.Binary.Defer.Graph- Data.Binary.Defer.Index- Data.Binary.Defer.Map- Data.Binary.Defer.Monad- Data.Binary.Defer.Trie- Data.Binary.Defer.Vector- Data.Binary.Raw- Data.Heap- Data.Key- Data.Range- Data.TagStr- Data.TypeMap- General.CGI- General.Code- General.Glob- General.TextUtil- General.Util- Hoogle.All- Hoogle.DataBase.Aliases- Hoogle.DataBase.All- Hoogle.DataBase.Instances- Hoogle.DataBase.Items- Hoogle.DataBase.NameSearch- Hoogle.DataBase.Serialise- Hoogle.DataBase.Suggest- Hoogle.DataBase.Type- Hoogle.DataBase.TypeSearch.All- Hoogle.DataBase.TypeSearch.Binding- Hoogle.DataBase.TypeSearch.Cost- Hoogle.DataBase.TypeSearch.EntryInfo- Hoogle.DataBase.TypeSearch.Graph- Hoogle.DataBase.TypeSearch.Graphs- Hoogle.DataBase.TypeSearch.Result- Hoogle.DataBase.TypeSearch.TypeScore- Hoogle.Item.All- Hoogle.Item.Haddock- Hoogle.Item.Item- Hoogle.Operations.All- Hoogle.Operations.Convert- Hoogle.Operations.Rank- Hoogle.Operations.RankSolve- Hoogle.Query.All- Hoogle.Query.Parser- Hoogle.Query.Render- Hoogle.Query.Suggest- Hoogle.Query.Type- Hoogle.Search.All- Hoogle.Search.Result- Hoogle.Search.Results- Hoogle.TextBase.All- Hoogle.TextBase.Parser- Hoogle.TextBase.Type- Hoogle.TypeSig.All- Hoogle.TypeSig.Parser- Hoogle.TypeSig.Type- Test.All- Test.General- Test.Parse_Query- Test.Parse_TextBase- Test.Parse_TypeSig- Web.Action- Web.All- Web.Page+flag splitBase+ Description: Choose the new smaller, split-up base package.++executable hoogle+ build-depends: parsec, filepath, safe, uniplate, mtl, time+ if flag(splitBase)+ build-depends: base >= 3, directory, process, containers, array, bytestring+ else+ build-depends: base < 3++ main-is: Main.hs+ hs-source-dirs: src+ other-modules:+ CmdLine.Action+ CmdLine.All+ CmdLine.Files+ CmdLine.Flag+ CmdLine.Query+ CmdLine.Search+ CmdLine.Test+ Data.Binary.Defer+ Data.Binary.Defer.Array+ Data.Binary.Defer.Class+ Data.Binary.Defer.Index+ Data.Binary.Defer.Map+ Data.Binary.Defer.Monad+ Data.Binary.Defer.Trie+ Data.Binary.Defer.Vector+ Data.Binary.Raw+ Data.Heap+ Data.Key+ Data.Range+ Data.TagStr+ Data.TypeMap+ General.CGI+ General.Code+ General.Glob+ General.TextUtil+ General.Util+ Hoogle.All+ Hoogle.DataBase.Aliases+ Hoogle.DataBase.All+ Hoogle.DataBase.Instances+ Hoogle.DataBase.Items+ Hoogle.DataBase.NameSearch+ Hoogle.DataBase.Serialise+ Hoogle.DataBase.Suggest+ Hoogle.DataBase.Type+ Hoogle.DataBase.TypeSearch.All+ Hoogle.DataBase.TypeSearch.Binding+ Hoogle.DataBase.TypeSearch.Cost+ Hoogle.DataBase.TypeSearch.EntryInfo+ Hoogle.DataBase.TypeSearch.Graph+ Hoogle.DataBase.TypeSearch.Graphs+ Hoogle.DataBase.TypeSearch.Result+ Hoogle.DataBase.TypeSearch.TypeScore+ Hoogle.Item.All+ Hoogle.Item.Haddock+ Hoogle.Item.Item+ Hoogle.Item.URL+ Hoogle.Operations.All+ Hoogle.Operations.Combine+ Hoogle.Operations.Convert+ Hoogle.Operations.Rank+ Hoogle.Operations.RankSolve+ Hoogle.Query.All+ Hoogle.Query.Parser+ Hoogle.Query.Render+ Hoogle.Query.Suggest+ Hoogle.Query.Type+ Hoogle.Search.All+ Hoogle.Search.Result+ Hoogle.Search.Results+ Hoogle.TextBase.All+ Hoogle.TextBase.Parser+ Hoogle.TextBase.Type+ Hoogle.TypeSig.All+ Hoogle.TypeSig.Parser+ Hoogle.TypeSig.Type+ Test.All+ Test.General+ Test.Parse_Query+ Test.Parse_TextBase+ Test.Parse_TypeSig+ Web.Action+ Web.All+ Web.Page+ Web.Text
src/CmdLine/Action.hs view
@@ -56,6 +56,18 @@ mapM_ (actionConvert q) [x | Convert x <- queryFlags q] +actionCmdLine q | Combine{} `elemEnum` queryFlags q = do+ -- TODO: Work around a bug in CmdLine.Flags, try /merge=t1;t2+ -- and you get [t1,t1,t2,t2]+ let files = nub [x | Combine x <- queryFlags q]+ outfile = headDef "default.hoo" [x | Output x <- queryFlags q]+ putStrLn $ "Combining " ++ show (length files) ++ " databases"+ combine files outfile+ when (Dump{} `elemEnum` queryFlags q) $ do+ putStrLn ""+ actionDump q outfile++ actionCmdLine q | Dump{} `elemEnum` queryFlags q = do dbs <- getDataBaseFiles (queryFlags q) (fromRight $ query q) mapM_ (actionDump q) dbs@@ -84,7 +96,8 @@ actionConvert q infile = do let outfile = headDef (replaceExtension infile "hoo") [x | Output x <- queryFlags q] putStrLn $ "Converting " ++ infile- convert (Debug `elem` queryFlags q) infile outfile+ deps <- getDataBaseFilesNoDefault (queryFlags q) (fromRight $ query q)+ convert (Debug `elem` queryFlags q) deps infile outfile putStrLn $ "Written " ++ outfile when (Dump{} `elemEnum` queryFlags q) $ do@@ -95,5 +108,5 @@ actionTest :: CmdQuery -> FilePath -> IO () actionTest q infile = do- outfile <- actionConvert q infile+ outfile <- actionConvert q{queryFlags = Debug : queryFlags q} infile testFile infile outfile
src/CmdLine/Files.hs view
@@ -1,5 +1,5 @@ -module CmdLine.Files(getDataBaseFiles) where+module CmdLine.Files(getDataBaseFiles, getDataBaseFilesNoDefault) where import CmdLine.Flag import General.Glob@@ -12,16 +12,23 @@ -- otherwise use the CmdFlag and any +package query flags getDataBaseFiles :: [CmdFlag] -> Query -> IO [FilePath] getDataBaseFiles flags q = do+ xs <- getDataBaseFilesNoDefault flags q+ if null xs+ then liftM (:[]) $ resolve flags "default"+ else return xs+++getDataBaseFilesNoDefault :: [CmdFlag] -> Query -> IO [FilePath]+getDataBaseFilesNoDefault flags q = do let dataFil = [x | DataFile x <- flags] plusPkg = [x | PlusPackage x <- scope q]- if null dataFil && null plusPkg then- liftM (:[]) $ resolve "default"- else do- rs <- mapM resolve plusPkg- return $ dataFil ++ rs- where- inc = [x | Include x <- flags]- resolve x = do- dataDir <- getDataDir- [x] <- globFile (inc++[dataDir]) ["hoo"] x- return x+ rs <- mapM (resolve flags) plusPkg+ return $ dataFil ++ rs+++resolve :: [CmdFlag] -> String -> IO FilePath+resolve flags x = do+ let inc = [x | Include x <- flags]+ dataDir <- getDataDir+ [x] <- globFile (inc++[dataDir]) ["hoo"] x+ return x
src/CmdLine/Flag.hs view
@@ -34,12 +34,14 @@ | Include FilePath -- ^ Include directory | TestFile FilePath -- ^ Run tests in a file | Rank FilePath -- ^ Generate rankings+ | Combine FilePath -- ^ Merge a set of databases+ | Mode String -- ^ Web modes deriving (Show,Eq {-! Enum !-} ) -- | In which circumstances are you allowed to pass this command data Permission = PWebArgs | PWebQuery | PCmdLine | PMultiple- deriving Eq+ deriving (Show,Eq) data Argument = ArgNone CmdFlag | ArgBool (Bool -> CmdFlag)@@ -88,6 +90,8 @@ ,f (ArgDir Include) ["i","include"] [PCmdLine,PMultiple] "Include directories" ,f (ArgFileIn TestFile ["txt"]) ["testfile"] [PCmdLine,PMultiple] "Run tests from a file" ,f (ArgFileIn Rank ["txt"]) ["rank"] [PCmdLine,PMultiple] "Generate ranking scores"+ ,f (ArgFileIn Combine ["hoo"]) ["combine"] [PCmdLine,PMultiple] "Combine multiple databases"+ ,f (ArgStr Mode) ["mode"] [PCmdLine,PWebArgs] "Web mode" ] where f = FlagInfo @@ -147,6 +151,7 @@ -- Parsing Flags -- TODO: check no flag is specified twice+-- TODO: Fix a bug, try /merge=t1;t2 and you get [t1,t1,t2,t2] parseFlags :: Permission -> [(String,String)] -> IO ([CmdFlag],[String]) parseFlags perm xs = do let args = concatMap (parseFlag perm) xs@@ -207,7 +212,7 @@ -------------------------------------------------------- -- DERIVES GENERATED CODE -- DO NOT MODIFY BELOW THIS LINE--- CHECKSUM: 780144949+-- CHECKSUM: 1401092643 instance Enum CmdFlag where toEnum 0 = Version{}@@ -227,6 +232,7 @@ toEnum 14 = Include{} toEnum 15 = TestFile{} toEnum 16 = Rank{}+ toEnum 17 = Combine{} toEnum n = error ((++) "toEnum " ((++) (show n) ", not defined for CmdFlag")) fromEnum (Version {}) = 0 fromEnum (Web {}) = 1@@ -245,3 +251,4 @@ fromEnum (Include {}) = 14 fromEnum (TestFile {}) = 15 fromEnum (Rank {}) = 16+ fromEnum (Combine {}) = 17
src/CmdLine/Query.hs view
@@ -51,7 +51,7 @@ (flags2,bad2) <- flagsWebQuery $ queryArgs res return $ CmdQuery True str (Right res) (flags2++flags1) (bad2++bad1) where- (q,notq) = partition ((==) "q" . fst) xs+ (q,notq) = partition ((`elem` ["q","hoogle"]) . fst) xs str = unwords $ map snd q
src/CmdLine/Search.hs view
@@ -35,9 +35,12 @@ if null res then putStrLn "No results found" else if Info `elemEnum` flags then do- putStrLn $ f $ renderResult $ head res- putStrLn ""- putStrLn $ showTag $ renderHaddock $ entryDocs $ fromLink $ resultEntry $ head res+ let ent = fromLink $ resultEntry $ head res+ pkg = fromLink $ entryPackage ent+ putStrLns 2 $ f $ renderResult $ head res+ putStrLns 2 $ showTag $ renderHaddock $ entryDocs ent+ putStrLn $ "From package " ++ packageName pkg ++ ", version " ++ packageVersion pkg+ putStrLns 1 $ entryURL ent else putStr $ unlines $ map (f . renderResult) res where@@ -52,3 +55,11 @@ f (m,r,v) = maybe "" (\m -> showModule m ++ " ") m ++ showTag r ++ (if verbose then " -- " ++ v else "")+++-- Put out a string with some blank links following+-- Do not put out the blank lines if no text output+putStrLns :: Int -> String -> IO ()+putStrLns n xs = when (xs /= "") $ do+ putStr xs+ putStr $ replicate n '\n'
src/CmdLine/Test.hs view
@@ -20,7 +20,10 @@ putStrLn $ show (length bad) ++ " tests failed" --- LineNo Query Results+-- LineNo Query NoResults YesResults+-- NoResults is a list of results that are not allowed to appear+-- YesResults are sets of results, which must be in order, and within a set must+-- have the same Score data Test = Test Int String Query [String] [[String]] deriving Show
− src/Data/Binary/Defer/Chunk.hs
@@ -1,51 +0,0 @@--module Data.Binary.Defer.Chunk(- Chunk, newChunk,- lookupChunk- ) where--import Control.Monad-import Data.Binary.Defer-import Data.Binary.Defer.Array-import Data.Range---chunkSize = 100 :: Int--newtype Chunk a = Chunk (Array (Vector a))-newtype Vector a = Vector {unVector :: [a]}---newChunk :: [a] -> Chunk a-newChunk = Chunk . array . f- where- f [] = []- f xs = Vector a : f b- where (a,b) = splitAt chunkSize xs---lookupChunk :: Range -> Chunk a -> [a]-lookupChunk r (Chunk xs) =- drop m $ f d (count + m)- where- (start,count) = (rangeStart r, rangeCount r)- (d,m) = start `divMod` chunkSize-- f i n | n == 0 = []- | n < chunkSize = take n $ unVector $ xs ! i- | otherwise = unVector (xs ! i) ++ f (i+1) (n-chunkSize)---instance BinaryDefer a => BinaryDefer (Chunk a) where- put (Chunk a) = put a- get = get1 Chunk--instance BinaryDefer a => BinaryDefer (Vector a) where- put (Vector xs) = putInt (length xs) >> mapM_ put xs- get = do- i <- getInt- liftM Vector $ replicateM i get--instance Show a => Show (Chunk a) where- show (Chunk xs) = unlines $ zipWith f [0..] $ concatMap unVector $ elems xs- where f i x = show i ++ " = " ++ show x
src/Data/Binary/Defer/Class.hs view
@@ -4,7 +4,8 @@ import Control.Monad import Data.Binary.Defer.Monad import Data.Binary.Raw-+import Data.ByteString(ByteString)+import General.Util(splitAtLength) --------------------------------------------------------------------- -- BinaryDefer@@ -34,6 +35,7 @@ get4 f = do x1 <- get; x2 <- get; x3 <- get; x4 <- get; return (f x1 x2 x3 x4) get5 f = do x1 <- get; x2 <- get; x3 <- get; x4 <- get; x5 <- get; return (f x1 x2 x3 x4 x5) get6 f = do x1 <- get; x2 <- get; x3 <- get; x4 <- get; x5 <- get; x6 <- get; return (f x1 x2 x3 x4 x5 x6)+get7 f = do x1 <- get; x2 <- get; x3 <- get; x4 <- get; x5 <- get; x6 <- get; x7 <- get; return (f x1 x2 x3 x4 x5 x6 x7) getFixed0 f = return f@@ -52,6 +54,7 @@ put4 x1 x2 x3 x4 = put x1 >> put x2 >> put x3 >> put x4 put5 x1 x2 x3 x4 x5 = put x1 >> put x2 >> put x3 >> put x4 >> put x5 put6 x1 x2 x3 x4 x5 x6 = put x1 >> put x2 >> put x3 >> put x4 >> put x5 >> put x6+put7 x1 x2 x3 x4 x5 x6 x7 = put x1 >> put x2 >> put x3 >> put x4 >> put x5 >> put x6 >> put x7 putFixed0 = return () :: DeferPut ()@@ -63,6 +66,13 @@ putFixed6 x1 x2 x3 x4 x5 x6 = putFixed x1 >> putFixed x2 >> putFixed x3 >> putFixed x4 >> putFixed x5 >> putFixed x6 +putEnumByte :: Enum a => a -> DeferPut ()+putEnumByte x = putByte $ fromIntegral $ fromEnum x++getEnumByte :: Enum a => DeferGet a+getEnumByte = liftM (toEnum . fromIntegral) getByte++ instance BinaryDefer Int where put = putInt get = getInt@@ -155,18 +165,30 @@ -- strategy: write out in 100 byte chunks, where each successive -- chunk is lazy, but the first is not instance BinaryDefer a => BinaryDefer [a] where- put xs | null b = putByte (length a) >> mapM_ put a- | otherwise = putByte maxByte >> mapM_ put a >> putDefer (put b)- where (a,b) = splitAt 100 xs+ put xs = putList xs get = do i <- getByte if i /= maxByte then do- replicateM i get+ replicateM (fromIntegral i) get else do xs <- replicateM 100 get ys <- getDefer get return (xs++ys)+++-- Extracted to allow putList to appear on the profile+putList :: BinaryDefer a => [a] -> DeferPut ()+putList xs | null b = putByte (fromIntegral n) >> mapM_ put a+ | otherwise = putByte maxByte >> mapM_ put a >> putDefer (put b)+ where (n,a,b) = splitAtLength 100 xs+++instance BinaryDefer ByteString where+ put = putDefer . putByteString+ get = getDefer getByteString+ putFixed = put+ getFixed = get newtype Defer a = Defer a
− src/Data/Binary/Defer/Graph.hs
@@ -1,136 +0,0 @@--module Data.Binary.Defer.Graph(- Graph, GraphNode, showGraphWith,- searchDijkstraState, searchDijkstraCycle,- Graph_(..), newGraph_,- graphFreeze, graphFollow- ) where--import Data.Binary.Defer-import Data.Binary.Defer.Array-import Data.List-import General.Code-import qualified Data.Heap as Heap-import qualified Data.Map as Map-import qualified Data.Set as Set--------------------------------------------------------------------------- GRAPH--data Graph n e = Graph (Array (Node n e))--data Node n e = Node {nodeResults :: [n], nodeEdges :: [(e, GraphNode)]}--type GraphNode = Int---showGraphWith :: (Show n, Show e) => (GraphNode -> String) -> Graph n e -> String-showGraphWith showNode (Graph xs) = unlines $ concat $ zipWith f [0..] $ elems xs- where- f i (Node res es) = showNode i : map (" "++) (r : map g es)- where r = if null res then "No results" else unwords (map show res)-- g (e,n) = showNode n ++ " ==> " ++ show e---instance (Show n, Show e) => Show (Graph n e) where- show = showGraphWith (\x -> '#':show x)---instance (BinaryDefer n, BinaryDefer e) => BinaryDefer (Graph n e) where- put (Graph a) = put1 a- get = get1 Graph--instance (BinaryDefer n, BinaryDefer e) => BinaryDefer (Node n e) where- put (Node a b) = put2 a b- get = get2 Node----- Given an initial (cost,state), and how to transform a (cost,state) along an edge--- return the (cost,state,node) pairs with the invariants that:--- Items are returned sorted by c--- No (_,s,n) pair is returned twice-searchDijkstraState :: (Ord c, Ord s) =>- (c,s) -> (e -> (c,s) -> (c,s)) ->- GraphNode -> Graph n e -> [(c,s,n)]-searchDijkstraState (c,s) gen n (Graph xs) = f Set.empty (Heap.singleton c (s,n))- where- f seen next = case Heap.pop next of- Nothing -> []- Just ((c,(s,n)),next)- | (s,n) `Set.member` seen -> f seen next- | otherwise -> [(c,s,n) | n <- ns] ++ f seen2 next2- where Node ns es = xs ! n- seen2 = Set.insert (s,n) seen- next2 = Heap.insertList [(c2,(s2,n)) | (e,n) <- es, let (c2,s2) = gen e (c,s)] next----- Invariant: No node is reached going through that node-searchDijkstraCycle :: Ord c =>- c -> (e -> c -> Maybe c) ->- GraphNode -> Graph n e -> [(c,n)]-searchDijkstraCycle c gen n (Graph xs) = f (Heap.singleton c (Set.singleton n,n))- where- f next = case Heap.pop next of- Nothing -> []- Just ((c,(s,n)),next) -> [(c,n) | n <- ns] ++ f (Heap.insertList new next)- where Node ns es = xs ! n- new = [ (c2, (Set.insert n s,n))- | (e,n) <- es, not $ n `Set.member` s- , Just c2 <- [gen e c]]--------------------------------------------------------------------------- MUTABLE GRAPH--data Graph_ k n e = Graph_ {graphResults :: [(k,n)], graphEdges :: [(k,k,e)]}- deriving Show---newGraph_ :: Graph_ k n e-newGraph_ = Graph_ [] []---graphKeys :: Graph_ k n e -> [k]-graphKeys (Graph_ res es) = map fst res ++ concatMap (\(a,b,c) -> [a,b]) es----- follow a node, if you create a new node, keep following-graphFollow :: Ord k => (k -> [(k,e)]) -> Graph_ k n e -> Graph_ k n e-graphFollow next g = g{graphEdges = graphEdges g ++ f Set.empty (graphKeys g)}- where- f seen [] = []- f seen (t:odo)- | t `Set.member` seen = f seen odo- | otherwise =- [(t,k,e) | (k,e) <- nxt] ++ f (Set.insert t seen) (map fst nxt ++ odo)- where nxt = next t---graphFreeze :: Ord k => Graph_ k n e -> (Graph n e, Map.Map k GraphNode)-graphFreeze (Graph_ res es) = (g, r)- where- g = Graph $ array $ map snd $ sortFst $ Map.elems mp- r = Map.map fst mp- mp = foldl' addEdge (foldl' addNode Map.empty (reverse res)) (reverse es)-- -- mp :: Map (key, (GraphNode, Node n e))- addNode mp (k1,n) = Map.insertWith f k1 new mp- where- new = (Map.size mp, Node [n] [])- f new (i, Node ns es) = (i, Node (n:ns) es)-- addEdge mp (k1,k2,e) = Map.insertWith f k1 new mp3- where- -- ensureKey k1 is important, even though ki1 is not needed- -- otherwise k1 may not make it into the map- (mp2,ki1) = ensureKey k1 mp- (mp3,ki2) = ensureKey k2 mp2- new = (Map.size mp, Node [] [(e, ki2)])- f new (i, Node ns es) = (i, Node ns ((e,ki2):es))-- ensureKey k mp = case Map.lookup k mp of- Just (y,_) -> (mp, y)- Nothing -> (Map.insert k (n, Node [] []) mp, n)- where n = Map.size mp
src/Data/Binary/Defer/Index.hs view
@@ -3,7 +3,7 @@ Id, Index, newIndex, Lookup, newLookup, lookupKey, lookupIndex,- Link, newLink, fromLink, linkKey,+ Link, newLink, fromLink, linkKey, indexLinks, Index_, newIndex_, getLink, getLookup, indexFreeze ) where @@ -107,6 +107,10 @@ size _ = size (0 :: Id) putFixed = put getFixed = get+++indexLinks :: Index a -> [Link a]+indexLinks (Index x) = zipWith newLink [0..] $ elems x ---------------------------------------------------------------------
src/Data/Binary/Defer/Monad.hs view
@@ -1,63 +1,179 @@ -module Data.Binary.Defer.Monad where+module Data.Binary.Defer.Monad(+ DeferPut, putDefer, runDeferPut,+ putInt, putByte, putChr, putByteString,+ DeferGet, getDefer, runDeferGet,+ getInt, getByte, getChr, getByteString,+ getDeferGet, getDeferPut+ ) where import System.IO import System.IO.Unsafe import Data.Binary.Raw import Control.Monad.Reader import Data.IORef+import qualified Data.ByteString as BS import Data.Typeable import qualified Data.TypeMap as TypeMap+import Foreign --------------------------------------------------------------------- -- Defer Put -type DeferPut a = ReaderT (Handle, IORef [DeferPending]) IO a-data DeferPending = DeferPending Integer (DeferPut ())+-- Storing the position explicitly gives a ~5% speed up+-- and removes hGetPos as being a bottleneck+-- possibly still not worth it though -putInt, putByte :: Int -> DeferPut ()-putInt x = do h <- asks fst; lift $ hPutInt h x-putByte x = do h <- asks fst; lift $ hPutByte h x+type DeferPut a = ReaderT (Buffer, IORef [DeferPending], IORef [DeferPatchup]) IO a+data DeferPending = DeferPending !Int (DeferPut ())+data DeferPatchup = DeferPatchup !Int !Int -- a b = at position a, write out b +putValue :: Storable a => a -> DeferPut ()+putValue x = do+ (buf,_,_) <- ask+ lift $ bufferAdd buf x++putInt :: Int -> DeferPut ()+putInt x = putValue (fromIntegral x :: Int32)++putByte :: Word8 -> DeferPut ()+putByte x = putValue x+ putChr :: Char -> DeferPut ()-putChr x = do h <- asks fst; lift $ hPutChar h x+putChr x = putByte $ fromIntegral $ fromEnum x +putByteString :: BS.ByteString -> DeferPut ()+putByteString x = do+ (buf,_,_) <- ask+ putInt $ BS.length x+ lift $ bufferAddByteString buf x+ putDefer :: DeferPut () -> DeferPut () putDefer x = do- (h,ref) <- ask- p <- lift $ hGetPos h- lift $ hPutInt h 0 -- to backpatch- lift $ modifyIORef ref (DeferPending p x :)+ (buf,ref,_) <- ask+ lift $ do+ p <- bufferPos buf+ bufferAdd buf (0 :: Int32) -- to backpatch+ modifyIORef ref (DeferPending p x :) runDeferPut :: Handle -> DeferPut () -> IO () runDeferPut h m = do+ buf <- bufferNew h ref <- newIORef []- runReaderT m (h,ref)- todo <- readIORef ref- mapM_ (runDeferPending h) (reverse todo)+ back <- newIORef []+ runReaderT (m >> runDeferPendings) (buf,ref,back)+ bufferFlush buf+ patch <- readIORef back+ mapM_ (\(DeferPatchup a b) -> do hSetPos h (toInteger a); hPutInt h b) patch -runDeferPending :: Handle -> DeferPending -> IO ()-runDeferPending h (DeferPending pos act) = do++runDeferPendings :: DeferPut ()+runDeferPendings = do+ (_,ref,back) <- ask+ todo <- lift $ readIORef ref+ lift $ writeIORef ref []+ mapM_ runDeferPending todo+++runDeferPending :: DeferPending -> DeferPut ()+runDeferPending (DeferPending pos act) = do+ (buf,_,back) <- ask+ lift $ do+ p <- bufferPos buf+ b <- bufferPatch buf pos (fromIntegral p :: Int32)+ when (not b) $ modifyIORef back (DeferPatchup pos p :)+ act+ runDeferPendings+++---------------------------------------------------------------------+-- Buffer for writing++bufferSize = 10000 :: Int++-- (number in file, number in buffer)+data Buffer = Buffer !Handle !(IORef Int) !(Ptr ()) !(IORef Int)+++bufferNew :: Handle -> IO Buffer+bufferNew h = do i <- hGetPos h- hSetPos h pos- hPutInt h (fromInteger i)- hSetPos h i- runDeferPut h act+ file <- newIORef $ fromInteger i+ buf <- newIORef 0+ ptr <- mallocBytes bufferSize+ return $ Buffer h file ptr buf +bufferAdd :: Storable a => Buffer -> a -> IO ()+bufferAdd (Buffer h file ptr buf) x = do+ let sz = sizeOf x+ buf2 <- readIORef buf+ if sz + buf2 >= bufferSize then do+ hPutBuf h ptr buf2+ pokeByteOff ptr 0 x+ modifyIORef file (+buf2)+ writeIORef buf sz+ else do+ pokeByteOff ptr buf2 x+ writeIORef buf (buf2+sz)+++bufferAddByteString :: Buffer -> BS.ByteString -> IO ()+bufferAddByteString (Buffer h file ptr buf) x = do+ let sz = BS.length x+ buf2 <- readIORef buf+ when (buf2 /= 0) $ do+ hPutBuf h ptr buf2+ writeIORef buf 0+ modifyIORef file (+ (buf2+sz)) + BS.hPut h x+++bufferFlush :: Buffer -> IO ()+bufferFlush (Buffer h file ptr buf) = do+ buf2 <- readIORef buf+ hPutBuf h ptr buf2+ modifyIORef file (+buf2)+ writeIORef buf 0+++bufferPos :: Buffer -> IO Int+bufferPos (Buffer h file ptr buf) = do+ i <- readIORef file+ j <- readIORef buf+ return $ i + j+++-- Patch at position p, with value v+-- Return True if you succeeded+bufferPatch :: Buffer -> Int -> Int32 -> IO Bool+bufferPatch (Buffer h file ptr buf) p v = do+ i <- readIORef file+ if p < i then return False else do+ pokeByteOff ptr (p-i) v+ return True+ --------------------------------------------------------------------- -- Defer Get type DeferGet a = ReaderT (Handle, IORef TypeMap.TypeMap) IO a -getInt, getByte :: DeferGet Int+getInt :: DeferGet Int getInt = do h <- asks fst; lift $ hGetInt h-getByte = do h <- asks fst; lift $ hGetByte h +getByte :: DeferGet Word8+getByte = do h <- asks fst; lift $ liftM fromIntegral $ hGetByte h+ getChr :: DeferGet Char getChr = do h <- asks fst; lift $ hGetChar h++getByteString :: DeferGet BS.ByteString+getByteString = do+ h <- asks fst+ len <- lift $ hGetInt h+ lift $ BS.hGet h len getDefer :: DeferGet a -> DeferGet a getDefer x = do
src/Data/Binary/Defer/Trie.hs view
@@ -1,6 +1,6 @@ module Data.Binary.Defer.Trie(- Trie, newTrie, lookupTrie+ Trie, newTrie, lookupTrie, unionsWith ) where import Data.Binary.Defer@@ -10,6 +10,7 @@ -- Keep simple first, can move to an Array later if necessary+-- the second list is always ordered data Trie a = Trie (Maybe a) [(Char,Trie a)] deriving Eq @@ -30,6 +31,29 @@ lookupTrie :: String -> Trie a -> Maybe a lookupTrie [] (Trie a b) = a lookupTrie (x:xs) (Trie a b) = lookup x b >>= lookupTrie xs+++unionsWith :: (a -> a -> a) -> [Trie a] -> Trie a+unionsWith f [] = newTrie []+unionsWith f [x] = x+unionsWith f (x:xs) = foldl (unionWith f) x xs+++unionWith :: (a -> a -> a) -> Trie a -> Trie a -> Trie a+unionWith merge (Trie x xs) (Trie y ys) = Trie xy $ f xs ys+ where+ xy = case (x,y) of+ (Just x, Nothing) -> Just x+ (Nothing, Just y) -> Just y+ (Just x, Just y) -> Just $ merge x y+ (Nothing,Nothing) -> Nothing++ f ((x1,x2):xs) ((y1,y2):ys) = case compare x1 y1 of+ EQ -> (x1,unionWith merge x2 y2) : f xs ys+ LT -> (x1,x2) : f xs ((y1,y2):ys)+ GT -> (y1,y2) : f ((x1,x2):xs) ys+ f xs [] = xs+ f [] ys = ys instance BinaryDefer a => BinaryDefer (Trie a) where
src/Data/Binary/Raw.hs view
@@ -12,6 +12,7 @@ import System.IO import Control.Monad import Data.Bits+import Data.Word import Data.Char @@ -22,7 +23,7 @@ hSetPos hndl i = hSeek hndl AbsoluteSeek i -maxByte :: Int+maxByte :: Word8 maxByte = 0xff -- FROM the Binary module, thanks to the Hac 07 people!
src/General/Code.hs view
@@ -22,5 +22,5 @@ import System.Directory import System.Environment import System.Exit-import System.FilePath hiding (FilePath)+import System.FilePath hiding (FilePath,combine) import System.IO
src/General/Util.hs view
@@ -252,3 +252,18 @@ errorLines :: [String] -> b errorLines [] = error "errorLines, finished" errorLines (x:xs) = trace x $ errorLines xs+++rep from to x = if x == from then to else x+++-- | Like splitAt, but also return the number of items that were split.+-- For performance.+splitAtLength :: Int -> [a] -> (Int,[a],[a])+splitAtLength n xs = f n xs+ where+ f i xs | i == 0 = (n,[],xs)+ f i [] = (n-i,[],[])+ f i (x:xs) = (a,x:b,c)+ where (a,b,c) = f (i-1) xs+
src/Hoogle/All.hs view
@@ -3,8 +3,9 @@ Query(..), parseQuery, renderQuery, suggestQuery, usefulQuery, Flag(..), DataBase, loadDataBase, showDataBase,- convert, rank,- searchAll, searchRange, Result(..)+ convert, rank, combine,+ searchAll, searchRange, Result(..),+ completions ) where import Hoogle.Query.All
src/Hoogle/DataBase/Aliases.hs view
@@ -1,6 +1,6 @@ module Hoogle.DataBase.Aliases(- Aliases, createAliases, normAliases+ Aliases, createAliases, normAliases, mergeAliases ) where import Hoogle.TextBase.All@@ -11,10 +11,10 @@ import General.Code -newtype Aliases = Aliases (Map.Map String Alias)+newtype Aliases = Aliases {fromAliases :: Map.Map String Alias} instance BinaryDefer Aliases where- put (Aliases a) = put a+ put = put . fromAliases get = get1 Aliases instance Show Aliases where@@ -32,11 +32,19 @@ get = get2 Alias -createAliases :: [TextItem] -> Aliases-createAliases ti = Aliases $ transitiveClosure $ Map.fromList- [ (name, Alias [v | TVar v <- args] rhs)- | ItemAlias (TypeSig _ lhs) (TypeSig _ rhs) <- ti- , let (TLit name, args) = fromTApp lhs]+createAliases :: [Aliases] -> [TextItem] -> Aliases+createAliases deps ti = mergeAliases (a:deps)+ where+ a = Aliases $ transitiveClosure $ Map.fromList+ [ (name, Alias [v | TVar v <- args] rhs)+ | ItemAlias (TypeSig _ lhs) (TypeSig _ rhs) <- ti+ , let (TLit name, args) = fromTApp lhs]+++-- the first is the most important+mergeAliases :: [Aliases] -> Aliases+mergeAliases [x] = x+mergeAliases xs = Aliases $ transitiveClosure $ Map.unions $ map fromAliases xs -- Must be careful with aliases which expand back to themselves
src/Hoogle/DataBase/All.hs view
@@ -12,19 +12,33 @@ import Hoogle.DataBase.Type import Hoogle.Item.All import Hoogle.DataBase.Serialise+import General.Code -createDataBase :: TextBase -> DataBase-createDataBase xs = DataBase items- (createNameSearch ys) (createTypeSearch aliases instances ys)- (createSuggest ys) aliases instances+createDataBase :: [DataBase] -> TextBase -> DataBase+createDataBase deps xs = DataBase items+ (createNameSearch ys) (createTypeSearch as is ys)+ (createSuggest (map suggest deps) zs) as is where- (items,ys) = createItems xs- zs = map fst ys- aliases = createAliases zs- instances = createInstances zs+ items = createItems xs+ ys = entriesItems items+ zs = map fst xs+ as = createAliases (map aliases deps) zs+ is = createInstances (map instances deps) zs +combineDataBase :: [DataBase] -> DataBase+combineDataBase dbs = DataBase items_+ (createNameSearch ys) (createTypeSearch as is ys)+ ss as is+ where+ items_ = mergeItems $ map items dbs+ ys = entriesItems items_+ ss = mergeSuggest $ map suggest dbs+ as = mergeAliases $ map aliases dbs+ is = mergeInstances $ map instances dbs++ searchName :: DataBase -> String -> [(Link Entry,EntryView,TextScore)] searchName db = searchNameSearch (nameSearch db) @@ -36,3 +50,7 @@ suggestion :: [DataBase] -> TypeSig -> Maybe (Either String TypeSig) suggestion db = askSuggest (map suggest db)+++completions :: DataBase -> String -> [String]+completions db = completionsNameSearch (nameSearch db)
src/Hoogle/DataBase/Instances.hs view
@@ -1,6 +1,6 @@ module Hoogle.DataBase.Instances(- Instances, createInstances,+ Instances, createInstances, mergeInstances, normInstances, hasInstance ) where @@ -13,7 +13,7 @@ -- Map type [classes]-newtype Instances = Instances (Map.Map String [String])+newtype Instances = Instances {fromInstances :: Map.Map String [String]} instance Show Instances where show (Instances mp) = unlines $ map f $ Map.toList mp@@ -21,15 +21,22 @@ instance BinaryDefer Instances where- put (Instances x) = put1 x+ put = put1 . fromInstances get = get1 Instances -createInstances :: [TextItem] -> Instances-createInstances xs = Instances $ foldl f Map.empty ys+createInstances :: [Instances] -> [TextItem] -> Instances+createInstances deps xs = mergeInstances (i:deps) where+ i = Instances $ foldl f Map.empty ys ys = [(v, c) | ItemInstance (TypeSig [] (TApp (TLit c) vs)) <- xs, TLit v <- vs] f mp (v,c) = Map.insertWith (++) v [c] mp+++mergeInstances :: [Instances] -> Instances+mergeInstances = Instances . Map.unionsWith (\x y -> nub $ x ++ y) . map fromInstances++ -- Convert:
src/Hoogle/DataBase/Items.hs view
@@ -34,58 +34,75 @@ -- temporary state structure-data S = S {pkg :: Package- ,modId :: Int- ,mods :: [Module]- ,modCur :: Maybe (Link Module)- ,entId :: Int- ,ents :: [(TextItem, Maybe Entry)]- }+data S a = S {count :: Int, values :: [a]} -createItems :: [(TextItem,String)] -> (Items, [(TextItem, Maybe (Link Entry))])-createItems xs = res- where- res = unS $ execState (mapM (uncurry f) xs) s0- s0 = S (Package "" "" "" "") 0 [] Nothing 0 []+newS = S (-1) []+newIndexS = newIndex . reverse . values+addS x (S i xs) = S (i+1) (x:xs)+getS (S i (x:xs)) = newLink i x+getS _ = error "DataBase.Items.getS, lacking a package/module?" - unS s = (Items (newIndex [pkg s])- ms- (newIndex $ mapMaybe (liftM fromLink . snd) esJ2)- ,map (id *** const Nothing) esN ++ esJ2)- where- ms = newIndex $ reverse $ mods s- (esJ,esN) = partition (isJust . snd) $ ents s- esJ2 = zipWith (\i (ti,Just e) -> (ti,Just $ newLink i e)) [0..] $- sortOn (entryScore . fromJust . snd) esJ - f :: TextItem -> String -> State S ()- f i@ItemInstance{} _ = addTextItem i+entriesItems :: Items -> [Link Entry]+entriesItems = indexLinks . entries - f i@(ItemAttribute "keyword" name) d = addEntry i False EntryKeyword d- [Keyword "keyword",Text " ",Focus name] - f i@(ItemAttribute name val) _ = do- addTextItem i- when (name == "package") $ modify $ \s -> s{pkg = (pkg s){packageName = val}}- when (name == "version") $ modify $ \s -> s{pkg = (pkg s){packageVersion = val}}+createItems :: [(TextItem,String)] -> Items+createItems xs = Items (newIndexS pkgs) (newIndexS mods)+ (newIndex $ sortOn entryScore ents)+ where+ (ents, (pkgs,mods)) = flip runState (newS,newS) $ concatMapM addTextItem $ init $ tails xs - f i@(ItemModule xs) d = do- s <- get- let modI = modId s- m = Module xs (newLink 0 $ lookupIndex (newLookup 0) (packages $ fst res))- put s{modId = modI + 1, mods = m : mods s- ,modCur = Just $ newLink modI m}- addEntry i True EntryModule d- [Keyword "module", Text $ ' ' : concatMap (++ ".") (init xs), Focus (last xs)] - f i d = addEntry i True EntryOther d (renderTextItem i)+-- add a TextItem to the state S+addTextItem :: [(TextItem,String)] -> State (S Package, S Module) [Entry]+addTextItem ((ti,doc):rest) = case ti of+ ItemInstance{} -> return [] - addTextItem i = modify $ \s -> s{ents = (i,Nothing) : ents s}+ ItemAttribute "keyword" name ->+ add False EntryKeyword [Keyword "keyword",Text " ",Focus name] - addEntry i modu typ doc txt = do- s <- get- let entI = entId s- e = Entry (if modu then modCur s else Nothing)+ ItemAttribute "package" name -> do+ modify $ \(ps,ms) -> (addS (addPkg (Package name "" "" "") rest) ps, ms)+ add False EntryPackage [Keyword "package",Text " ",Focus name]++ ItemAttribute _ _ -> return []++ ItemModule xs -> do+ modify $ \(ps,ms) -> (ps, addS (Module xs) ms)+ add True EntryModule [Keyword "module", Text $ ' ' : concatMap (++ ".") (init xs), Focus (last xs)]++ _ -> add True EntryOther (renderTextItem ti)+ where+ add modu typ txt = do+ (ps,ms) <- get+ let sig = case ti of ItemFunc _ s -> Just (Defer s); _ -> Nothing+ return [Entry (if modu then Just $ getS ms else Nothing) (getS ps) (headDef "" [i | Focus i <- txt])- txt typ (newHaddock doc)- put $ s{entId = entI + 1, ents = (i, Just e) : ents s}+ txt typ (newHaddock doc) sig]++ addPkg pkg ((ItemAttribute "version" x,_) : xs) = addPkg pkg{packageVersion=x} xs+ addPkg pkg ((ItemAttribute "haddock" x,_) : xs) = addPkg pkg{haddockURL =x} xs+ addPkg pkg ((ItemAttribute "hackage" x,_) : xs) = addPkg pkg{hackageURL =x} xs+ addPkg pkg _ = pkg+++mergeItems :: [Items] -> Items+mergeItems [x] = x+mergeItems xs = Items+ (newIndex $ concat $ reverse ps)+ (newIndex $ concat $ reverse ms)+ (newIndex $ sortOn entryScore $ concat $ reverse es)+ where+ (pi,ps,mi,ms,ei,es) = foldl' f (0,[],0,[],0,[]) xs++ f (pi,ps,mi,ms,ei,es) (Items p m e) =+ (pi+length p3,p3:ps, mi+length m3,m3:ms, ei+length e3,e3:es)+ where+ (p2,p3) = add pi p id+ (m2,m3) = add mi m id+ (e2,e3) = add ei e $ \x -> x{entryModule = liftM (\x -> m2 !! linkKey x) $ entryModule x+ ,entryPackage = p2 !! linkKey (entryPackage x)}++ add i xs f = (zipWith newLink [i..] xs2, xs2)+ where xs2 = map (f . fromLink) $ indexLinks xs
src/Hoogle/DataBase/NameSearch.hs view
@@ -2,14 +2,13 @@ module Hoogle.DataBase.NameSearch (NameSearch, createNameSearch ,TextScore, searchNameSearch+ ,completionsNameSearch ) where import Data.Binary.Defer-import Data.Binary.Defer.Trie-import Data.Binary.Defer.Chunk+import Data.Binary.Defer.Array import Data.Binary.Defer.Index-import Data.Char-import Data.List+import qualified Data.Map as Map import Data.Range import General.Code import Hoogle.Item.All@@ -19,85 +18,77 @@ --------------------------------------------------------------------- -- DATA TYPES -data NameSearch = NameSearch (Trie NameItem) (Chunk (Int,Link Entry))- deriving Show+{-+The idea is that NameItem's are sorted by name, so exact/start matching+is done by binary searching this list. -data NameItem = NameItem {nameStart :: Int- ,nameCountAll :: Int -- number that match exactly- ,nameCountAny :: Int -- number that match a prefix- }+The rest of the results are taken by unioning all the suggestions in the+second element, and searching in order. All the results will end up+sorted by name (since they have identical names) -instance Show NameItem where- show (NameItem a b c) = unwords $ map show [a,b,c]+The original code was based around a Trie, gave fast performance, but+didn't merge common strings and consumed about 10x the disk space.+-} -instance BinaryDefer NameSearch where- put (NameSearch a b) = put2 a b- get = get2 NameSearch+data NameSearch = NameSearch (Array NameItem) [(Char, IntList)] -instance BinaryDefer NameItem where- put (NameItem a b c) = put3 a b c- get = get3 NameItem+data NameItem = NameItem {key :: String+ ,rest :: Defer [(String, [Link Entry])]} -{--TRIE data structure -Given the functions "map" and "pm" we would generate:+instance Show NameSearch where+ show (NameSearch a b) =+ concat (zipWith (\a b -> show a ++ " " ++ show b) [0..] (elems a)) +++ unlines [c : " = " ++ show d | (c,d) <- b] -Trie:-"ap" (0,1,1)-"m" (1,1,2)-"ma" (2,0,1) -"map" (2,1,1)-"p" (3,1,2)-"pm" (4,1,1)+instance Show NameItem where+ show (NameItem a b) = unlines $ a : map f (fromDefer b)+ where f (a,b) = unwords $ " " : a : ['#' : show (linkKey x) | x <- b] -Chunk:-0 "ap" (1,[map])-1 "m" (1,[pm])-2 "map" (0,[map])-3 "p" (2,[map])-4 "pm" (0,[pm])+instance BinaryDefer NameSearch where+ put (NameSearch a b) = put2 a b+ get = get2 NameSearch -There will be one trie entry per unique substring.-There will be one chunk entry per suffix.-Both are sorted by the string they represent.+instance BinaryDefer NameItem where+ put (NameItem a b) = put2 a b+ get = get2 NameItem -[item] is the id of the item.--} --------------------------------------------------------------------- -- CREATION -createNameSearch :: [(a, Maybe (Link Entry))] -> NameSearch-createNameSearch xs = NameSearch- (newTrie $ f sub (zip [0..] pre))- (newChunk $ map snd pre)+createNameSearch :: [Link Entry] -> NameSearch+createNameSearch xs = NameSearch (array $ Map.elems items) (Map.toList shortcuts) where- ys = extractText xs- sub = map head $ group $ sort $ concatMap (substrs . fst) ys- pre = sortBy (compare `on` fst)- [(p,(i,e)) | (s,e) <- ys, (i,p) <- zip [0..] $ prefixes s]+ items = buildItems xs+ shortcuts = buildShortcuts items - f :: [String] -> [(Int,(String,a))] -> [(String,NameItem)]- f [] _ = []- f (x:xs) ys = (x,NameItem s neq (neq+npr)) : f xs ys2- where- s = fst $ head ys- (neq,npr) = (length eq, length pr)- (eq,ys2) = span ((==) x . fst . snd) ys- pr = takeWhile (isPrefixOf x . fst . snd) ys2 +buildShortcuts :: Map.Map String NameItem -> Map.Map Char IntList+buildShortcuts = Map.map (toIntList . sort) . foldl' add Map.empty . zip [0..] . Map.keys+ where+ add mp (i,s) = foldl' g mp $ nub s+ where g mp x = Map.insertWith (++) x [i] mp -extractText :: [(a, Maybe (Link Entry))] -> [(String, Link Entry)]-extractText xs = [(map toLower s, e) |(_, Just e) <- xs, Focus s <- entryText $ fromLink e] +buildItems :: [Link Entry] -> Map.Map String NameItem+buildItems = Map.map norm . foldl' add Map.empty+ where+ add mp e = Map.insertWith f ltext (NameItem ltext $ Defer [(text, [e])]) mp+ where+ text = entryName $ fromLink e+ ltext = map toLower text -substrs, prefixes :: [a] -> [[a]]-substrs = concatMap (tail . inits) . prefixes-prefixes = init . tails+ f _ (NameItem a b) = NameItem a $ Defer $ g $ fromDefer b+ g [] = [(text, [e])]+ g ((x1,x2):xs) | x1 == text = (x1, e : x2) : xs+ | otherwise = (x1,x2) : g xs + norm (NameItem a b) = NameItem a $ Defer $ f $ fromDefer b+ where f x = sortFst [(a, sortOn linkKey b) | (a,b) <- x] + --------------------------------------------------------------------- -- SEARCHING @@ -111,25 +102,128 @@ show TSNone = "_" +{-+Step 1: Binary search for find the exact match+Step 2: Follow from that item finding ones which start+Step 3: Use the hint set to merge into a list of results+-}+ searchNameSearch :: NameSearch -> String -> [(Link Entry,EntryView,TextScore)]-searchNameSearch (NameSearch trie chunk) str =- case lookupTrie (map toLower str) trie of- Nothing -> []- Just i -> nubIntOn (linkKey . fst3) $ order exact0E ++ order (exact0S ++ start) ++ order none+searchNameSearch (NameSearch items shortcuts) str = step1 ++ step2 ++ step3+ where+ lstr = map toLower str+ nstr = length str+ rangePrefix = FocusOn $ rangeStartCount 0 nstr++ (exact,prefix) = startPos items lstr+ (prefixes,lastpre) = followPrefixes items lstr prefix+++ step1 = if isJust exact then f TSExact yes ++ f TSStart no else [] where- (exact0,exactN) = partition ((==) 0 . fst) exact- (partial0,partialN) = partition ((==) 0 . fst) partial- (exact,partial) = splitAt (nameCountAll i) $- lookupChunk (rangeStartCount (nameStart i) (nameCountAny i)) chunk+ (yes,no) = partition ((==) str . fst) $ fromDefer $ rest $ items ! fromJust exact+ f scr xs = [(x, rangePrefix, scr) | x <- concatMap snd xs] - none = map (f $ const TSNone) $ exactN ++ partialN- (exact0E,exact0S) = partition ((==) TSExact . thd3) $ map (f test) exact0- start = map (f $ const TSStart) partial0- test e = if entryName e == str then TSExact else TSStart+ step2 = [(x, rangePrefix, TSStart) | x <- prefixes]++ seen i = fromMaybe prefix exact <= i && i <= lastpre+ step3 = [(e,view,TSNone) | i <- xs, let x = items ! i+ , Just p <- [testMatch lstr $ key x]+ , let view = FocusOn $ rangeStartCount p nstr+ , e <- concatMap snd $ fromDefer $ rest x]+ where xs = filter (not . seen) $ intersectOrds $+ map (maybe [] fromIntList . flip lookup shortcuts) $ nub lstr+++-- Return the index of the string as the first component+-- Return the first possible index of the prefix as the second+startPos :: Array NameItem -> String -> (Maybe Int, Int)+startPos xs x = f 0 (arraySize xs - 1) where+ f low high | high - low < 3 = g low high+ | otherwise =+ case compare x (key $ xs ! mid) of+ EQ -> (Just mid, mid+1)+ GT -> f (mid+1) high+ LT -> f low (mid-1)+ where+ mid = (high + low) `div` 2++ g low high | low > high = (Nothing, low)+ g low high = if k == x then (Just low, low+1)+ else if x `isPrefixOf` k then (Nothing, low)+ else g (low+1) high+ where k = key $ xs ! low+++-- Return all the items you can match following the prefix+-- Plus the last item that was a valid prefix index+followPrefixes :: Array NameItem -> String -> Int -> ([Link Entry], Int)+followPrefixes xs x i = f i+ where+ n = arraySize xs+ f i | i < n && x `isPrefixOf` key xsi = (concatMap snd (fromDefer $ rest xsi) ++ res, end)+ | otherwise = ([],i-1)+ where xsi = xs ! i+ (res,end) = f (i+1)+++testMatch :: String -> String -> Maybe Int+testMatch find within = listToMaybe [i | (i,x) <- zip [0..] $ tails within, find `isPrefixOf` x]+++intersectOrd :: [Int] -> [Int] -> [Int]+intersectOrd (x:xs) (y:ys) = case compare x y of+ EQ -> x : intersectOrd xs ys+ LT -> intersectOrd xs (y:ys)+ GT -> intersectOrd (x:xs) ys+intersectOrd _ _ = []+++intersectOrds :: [[Int]] -> [Int]+intersectOrds = fold1 intersectOrd+++---------------------------------------------------------------------+-- COMPLETIONS++completionsNameSearch :: NameSearch -> String -> [String]+completionsNameSearch (NameSearch items _) str =+ concatMap (map fst . fromDefer . rest) $+ takeWhile ((lstr `isPrefixOf`) . key) $+ map ((!) items) [start .. arraySize items - 1]+ where+ lstr = map toLower str nstr = length str- order = sortOn (linkKey . fst3) - f :: (Entry -> TextScore) -> (Int, Link Entry) -> (Link Entry,EntryView,TextScore)- f score (p,e) = (e, FocusOn (rangeStartCount p nstr), score $ fromLink e)+ (exact,prefix) = startPos items lstr+ start = fromMaybe prefix exact+++---------------------------------------------------------------------+-- IntList TYPE++type IntList = [IntRange]+data IntRange = IntRange !Int !Int++instance Show IntRange where+ show (IntRange a b) = show a ++ ".." ++ show b++instance BinaryDefer IntRange where+ put (IntRange a b) = put2 a b+ get = get2 IntRange+++toIntList :: [Int] -> IntList+toIntList [] = []+toIntList (x:xs) = f x xs+ where+ f i [] = [IntRange x i]+ f i (y:ys) | y == i+1 = f y ys+ | otherwise = IntRange x i : toIntList (y:ys)+++fromIntList :: IntList -> [Int]+fromIntList = concatMap (\(IntRange a b) -> [a..b])+
src/Hoogle/DataBase/Serialise.hs view
@@ -8,9 +8,13 @@ import General.Code import Hoogle.DataBase.Type+import Paths_hoogle+import Data.Version -hooVersion = 1 :: Int+hooVersion :: [Int]+hooVersion = take 4 $ versionBranch version ++ repeat 0+ hooString = "HOOG" @@ -18,7 +22,7 @@ saveDataBase file db = do h <- openBinaryFile file WriteMode mapM_ (hPutChar h) hooString- hPutInt h hooVersion+ mapM_ (hPutByte h) hooVersion runDeferPut h $ put db hClose h @@ -35,9 +39,10 @@ when (str /= hooString) $ error $ "Not a hoogle database: " ++ file - ver <- hGetInt h- when (ver /= hooVersion) $- error $ "Wrong hoogle database version: " ++ show ver ++- " found, expected " ++ show hooVersion+ let showVer = showVersion . flip Version []+ ver <- replicateM 4 (hGetByte h)+ when (ver /= hooVersion && "hugs" `notElem` versionTags version) $+ error $ "Wrong hoogle database version: " ++ showVer ver +++ " found, expected " ++ showVer hooVersion runDeferGet h get
src/Hoogle/DataBase/Suggest.hs view
@@ -1,11 +1,9 @@ --- TODO: Suggestions from imported packages should be detailed- module Hoogle.DataBase.Suggest where import General.Code import Data.Binary.Defer-import Data.Binary.Defer.Trie+import Data.Binary.Defer.Trie as Trie import Data.Binary.Defer.Index import qualified Data.Map as Map import Hoogle.TextBase.All@@ -14,6 +12,8 @@ import Data.Generics.Uniplate +-- TODO: Move to a Map, first benchmark how much this slows down the+-- searching, versus how much space is saved newtype Suggest = Suggest {fromSuggest :: Trie SuggestItem} -- if something is both a data and a ctor, no need to mention the ctor@@ -45,10 +45,11 @@ -- note: do not look inside class's for data type information -- as they may have higher-kinds and get it wrong-createSuggest :: [(TextItem, a)] -> Suggest-createSuggest xs = Suggest $ newTrie $ Map.toList res+createSuggest :: [Suggest] -> [TextItem] -> Suggest+createSuggest deps xs = mergeSuggest (s:deps) where- res = foldl f Map.empty $ concatMap (getTextItem . fst) xs+ s = Suggest $ newTrie $ Map.toList res+ res = foldl f Map.empty $ concatMap getTextItem xs where f m (s,i) = Map.insertWith joinItem (map toLower s) i m sData c n = (c, SuggestItem Nothing [(c,n)] [])@@ -77,16 +78,22 @@ , (TLit c,_) <- [fromTApp $ last $ fromTFun x]] +mergeSuggest :: [Suggest] -> Suggest+mergeSuggest = Suggest . Trie.unionsWith joinItem . map fromSuggest++ joinItem :: SuggestItem -> SuggestItem -> SuggestItem joinItem (SuggestItem a1 b1 c1) (SuggestItem a2 b2 c2) = SuggestItem (if null b1 && null b2 then a1 `mplus` a2 else Nothing)- (nub $ b1++b2) (nub $ c1++c2)+ (f b1 b2) (f c1 c2)+ where+ f x y = map (id *** maximum) $ sortGroupFsts $ x ++ y askSuggest :: [Suggest] -> TypeSig -> Maybe (Either String TypeSig) askSuggest sug q@(TypeSig con typ)- | typ2 /= typ = Just (Right $ TypeSig con typ2)+ | q2 /= q = Just (Right q2) | not $ null datas = unknown "type" datas | not $ null classes = unknown "class" classes | otherwise = Nothing@@ -96,6 +103,12 @@ [] -> Nothing xs -> Just $ foldr1 joinItem xs + con2 = map (improve get True) con+ typ2 = improve get False typ+ q2 = contextTrim $ insertVars $ TypeSig con2 typ2+ insertVars = transformSig (\x -> if x == TVar "" then TVar var else x)+ var = head $ filter (/= "") $ variables typ2 ++ concatMap variables con2 ++ ["a"]+ -- figure out if you have a totally unknown thing -- classes = [x | c <- con, (TLit x,_) <- [fromTApp c], bad True x] datas = [x | TLit x <- concatMap universe $ typ : concatMap (snd . fromTApp) con@@ -107,27 +120,45 @@ Just i | cls -> null $ suggestClass i | otherwise -> null (suggestData i) && isNothing (suggestCtor i) - -- try and improve the type --- typ2 = removeTApp $ transform f $ insertTApp typ- where- free = map (TVar . (:[])) $ ['a'..] \\ [x | TVar [x] <- universe typ] - f (TVar x) | length x > 1 = g (TVar x) x- f (TLit x) = g (TLit x) x- f (TApp (TLit x) xs) | isJust m && not (null kinds) && n `notElem` kinds =- TApp (TLit x) $ if maximum kinds > n- then xs ++ take (minimum (filter (> n) kinds) - n) free- else take (maximum kinds) xs- where- m@ ~(Just SuggestItem{suggestData=d}) = get x- kinds = [b | (a,b) <- d, a == x]- n = length xs- f x = x+-- remove context which doesn't reference variables in the RHS+contextTrim :: TypeSig -> TypeSig+contextTrim (TypeSig con typ) = TypeSig (filter (not . bad) con) typ+ where var = variables typ+ bad x = isTVar (fst $ fromTApp x) || null (variables x `intersect` var) - g def x | isJust m && x `notElem` (map fst d) &&- (not (null d) || isJust c)- = if isJust c then TLit $ fromJust c- else TLit $ fst $ head $ d- where m@ ~(Just SuggestItem{suggestData=d, suggestCtor=c}) = get x- g def x = def+improve :: (String -> Maybe SuggestItem) -> Bool -> Type -> Type+improve get cls typ+ | cls == False = f $ transform (improveName nameTyp) typ+ | cls == True = improveArity arity $+ tApp (improveName nameCls t1) (map (transform (improveName nameTyp)) ts)+ where+ (t1,ts) = fromTApp typ+ nameTyp = maybe [] (\x -> maybeToList (suggestCtor x) ++ map fst (suggestData x)) . get+ nameCls = maybe [] (map fst . suggestClass) . get+ + arity x = lookup x . (if cls then suggestClass else suggestData) =<< get x+ + f x = case improveArity arity x of+ TApp x xs -> TApp x (map f xs)+ x -> descend f x+++-- Given a name, return its arity+improveArity :: (String -> Maybe Int) -> Type -> Type+improveArity f o = case fromTApp o of+ (TLit x, xs) ->+ case f x of+ Just i -> tApp (TLit x) $ take i $ xs ++ repeat (TVar "")+ _ -> o+ _ -> o+++-- Given a name, return the names it could possibly be+improveName :: (String -> [String]) -> Type -> Type+improveName f (TLit x) | ys /= [] && x `notElem` ys = TLit (head ys)+ where ys = f x+improveName f (TVar x) | length x > 1 && ys /= [] = TLit (head ys)+ where ys = f x+improveName f x = x
src/Hoogle/DataBase/Type.hs view
@@ -19,14 +19,13 @@ import General.Code +-- suggest, aliases and instances are used for linking with packages+-- that depend on this database data DataBase = DataBase {items :: Items ,nameSearch :: NameSearch ,typeSearch :: TypeSearch ,suggest :: Suggest- -- aliases and instances are stored- -- but only used for linking with packages that depend- -- on this database ,aliases :: Aliases ,instances :: Instances }
src/Hoogle/DataBase/TypeSearch/All.hs view
@@ -31,9 +31,9 @@ --------------------------------------------------------------------- -- CREATION -createTypeSearch :: Aliases -> Instances -> [(TextItem, Maybe (Link Entry))] -> TypeSearch+createTypeSearch :: Aliases -> Instances -> [Link Entry] -> TypeSearch createTypeSearch aliases instances xs = TypeSearch $ newGraphs aliases instances types- where types = [(e, sig) | (ItemFunc _ sig, Just e) <- xs]+ where types = [(x, fromDefer sig) | x <- xs, Just sig <- [entryTypesig $ fromLink x]] ---------------------------------------------------------------------
src/Hoogle/DataBase/TypeSearch/Binding.hs view
@@ -1,6 +1,8 @@ {-| Deal with variable bindings/alpha renaming in searches And with restrictions++ Deals with how the query is mapped to the result -} module Hoogle.DataBase.TypeSearch.Binding(@@ -117,4 +119,4 @@ bindings :: Binding -> [(Type, Type)] bindings (Binding _ _ a b) = [(TVar v, t) | (v,(l,vs)) <- Map.toList a, t <- [TLit l | Just l <- [l]] ++ map TVar (Set.toList vs)] ++- [(TVar v, TLit l) | (v,(Just l,_)) <- Map.toList b]+ [(TLit l, TVar v) | (v,(Just l,_)) <- Map.toList b]
src/Hoogle/DataBase/TypeSearch/Cost.hs view
@@ -21,6 +21,7 @@ | CostInstanceDel | CostInstanceAdd | CostDeadArg+ | CostArgReorder deriving (Show,Eq,Ord,Enum,Bounded) @@ -40,3 +41,4 @@ cost CostInstanceDel = 4 -- 4..999 cost CostInstanceAdd = 4 -- 4..999 cost CostDeadArg = 3 -- 3..998+cost CostArgReorder = 1 -- 1..1000
src/Hoogle/DataBase/TypeSearch/Graph.hs view
@@ -24,8 +24,6 @@ import qualified Data.Heap as Heap import General.Code import Data.Key-import qualified Data.Binary.Defer.Graph as G-import Data.Binary.Defer.Graph hiding (Graph, Graph_)
src/Hoogle/DataBase/TypeSearch/Result.hs view
@@ -83,8 +83,9 @@ newGraphsResults :: Instances -> EntryInfo -> Link EntryInfo -> [ResultArg] -> ResultArg -> Maybe Result newGraphsResults is query e args res = do b <- mergeBindings $ map resultArgBind $ args ++ [res]- let s = newTypeScore is query (fromLink e) b- view = zipWith ArgPosNum [0..] $ map resultArgPos args+ let aps = map resultArgPos args+ s = newTypeScore is query (fromLink e) (aps == sort aps) b+ view = zipWith ArgPosNum [0..] aps -- need to fake at least one ArgPosNum, so we know we have some highlight info view2 = [ArgPosNum (-1) (-1) | null view] ++ view return (e, view2, s)
src/Hoogle/DataBase/TypeSearch/TypeScore.hs view
@@ -16,6 +16,7 @@ data TypeScore = TypeScore {costTypeScore :: !Int ,badargs :: Int+ ,badorder :: Bool ,bind :: Binding ,badInstance :: (TypeContext, TypeContext) ,badAlias :: ([String], [String])@@ -26,6 +27,7 @@ show t = unwords $ ['#' : show (costTypeScore t)] ++ replicate (badargs t) "badarg" +++ ["badorder" | badorder t] ++ [show $ bind t] ++ both inst (badInstance t) ++ both alis (badAlias t)@@ -42,11 +44,12 @@ compare = compare `on` costTypeScore -newTypeScore :: Instances -> EntryInfo -> EntryInfo -> Binding -> TypeScore-newTypeScore is query result bs = t{costTypeScore = calcScore t}+newTypeScore :: Instances -> EntryInfo -> EntryInfo -> Bool -> Binding -> TypeScore+newTypeScore is query result inorder bs = t{costTypeScore = calcScore t} where t = TypeScore 0 (entryInfoArity result - entryInfoArity query)+ (not inorder) bs (entryInfoContext query `diff` ctx) (entryInfoAlias query `diff` entryInfoAlias result)@@ -64,6 +67,7 @@ costsTypeScoreLocal :: TypeScore -> [Cost] costsTypeScoreLocal t = CostDeadArg *+ badargs t +++ [CostArgReorder | badorder t] ++ CostAliasFwd *+ length (fst $ badAlias t) ++ CostAliasBwd *+ length (snd $ badAlias t) ++ CostInstanceAdd *+ length (fst $ badInstance t) ++
src/Hoogle/Item/All.hs view
@@ -1,8 +1,10 @@ module Hoogle.Item.All( module Hoogle.Item.Item,- module Hoogle.Item.Haddock+ module Hoogle.Item.Haddock,+ module Hoogle.Item.URL ) where import Hoogle.Item.Item import Hoogle.Item.Haddock+import Hoogle.Item.URL
src/Hoogle/Item/Haddock.hs view
@@ -6,10 +6,10 @@ import General.Code import Data.TagStr import Data.Binary.Defer-import Data.Binary.Defer.Vector+import Data.ByteString.Char8(ByteString,pack,unpack) -newtype Haddock = Haddock (Vector Char)+newtype Haddock = Haddock ByteString instance BinaryDefer Haddock where@@ -17,11 +17,11 @@ get = get1 Haddock -newHaddock = Haddock . fromList+newHaddock = Haddock . pack renderHaddock :: Haddock -> TagStr-renderHaddock (Haddock xs) = Tags $ f False $ parseHaddock $ toList xs+renderHaddock (Haddock xs) = Tags $ f False $ parseHaddock $ unpack xs where nl = Char '\n' @@ -31,11 +31,14 @@ f True (Char '\n':xs) = Str "\n" : Str "> " : f True xs + -- TODO: tt is ignored, add a TagMonospage? f pre (Tag "tt" x:xs) = f pre (x++xs) f pre (Tag [t,'l'] x:xs) | t `elem` "ou" = tail $ f pre (filter (/= nl) x ++ xs) f pre (Tag "pre" x:xs) = init (init $ tail $ f True x) ++ f pre xs f pre (Tag "li" x:xs) = Str "\n" : Str "* " : f pre x ++ f pre xs- f pre (Tag "a" x:xs) = TagUnderline (Tags $ f pre x) : f pre xs+ f pre (Tag "a" x:xs) = TagHyperlink "" (Tags $ f pre x) : f pre xs+ f pre (Tag "i" x:xs) = TagUnderline (Tags $ f pre x) : f pre xs+ f pre (Tag "b" x:xs) = TagBold (Tags $ f pre x) : f pre xs f pre (Tag n x:xs) = Str (show (Tag n x)) : f pre xs f pre (Char x:xs) = Str [x] : f pre xs
src/Hoogle/Item/Item.hs view
@@ -16,7 +16,7 @@ {packageName :: String ,packageVersion :: String ,haddockURL :: String- ,hscolourURL :: String+ ,hackageURL :: String } typename_Package = mkTyCon "Hoogle.DataBase.Item.Package"@@ -25,22 +25,27 @@ data Module = Module {moduleName :: [String]- ,modulePackage :: Link Package } typename_Module = mkTyCon "Hoogle.DataBase.Item.Module" instance Typeable Module where typeOf _ = mkTyConApp typename_Module [] +-- TODO: Is entryName every used? Can it make use of the invariant?+-- Perhaps just store the entryText, then regenerate entryName at load time+ -- invariant: entryName == head [i | Focus i <- entryText] data Entry = Entry {entryModule :: Maybe (Link Module)+ ,entryPackage :: Link Package ,entryName :: String ,entryText :: [EntryText] ,entryType :: EntryType ,entryDocs :: Haddock+ ,entryTypesig :: Maybe (Defer TypeSig) } + typename_Entry = mkTyCon "Hoogle.DataBase.Item.Entry" instance Typeable Entry where typeOf _ = mkTyConApp typename_Entry [] @@ -57,10 +62,15 @@ deriving Show data EntryType = EntryModule+ | EntryPackage | EntryKeyword | EntryOther deriving (Eq,Enum,Show) ++-- TODO: EntryScore is over-prescriptive, and not overly useful+-- Have name and type scores to it themselves, using name only+-- to break ties when merging -- the number of elements in the module name -- the name of the entry, in lower case -- the name of the entry@@ -71,7 +81,8 @@ entryScore :: Entry -> EntryScore entryScore e = EntryScore- (length m) (map toLower $ entryName e) (entryName e) m+ (if entryType e == EntryOther then length m else 0)+ (map toLower $ entryName e) (entryName e) m where m = maybe [] (moduleName . fromLink) $ entryModule e @@ -104,14 +115,17 @@ renderTextItem :: TextItem -> [EntryText] renderTextItem x = case x of ItemClass i -> [Keyword "class", Text " "] ++ typeHead i- ItemFunc name typ -> [Focus name, Text " :: "] ++ renderTypeSig typ+ ItemFunc name typ -> operator name ++ [Text " :: "] ++ renderTypeSig typ ItemAlias a b -> [Keyword "type", Text " "] ++ typeHead a ++ [Text $ " = " ++ show b] ItemData d t -> [Keyword (show d), Text " "] ++ typeHead t where typeHead (TypeSig con sig) = [Text $ showConstraint con, Focus a, Text b] where (a,b) = break (== ' ') $ show sig + operator xs@(x:_) | not $ isAlpha x || x `elem` "#_'" = [Text "(",Focus xs,Text ")"]+ operator xs = [Focus xs] + renderTypeSig :: TypeSig -> [EntryText] renderTypeSig (TypeSig con sig) = Text (showConstraint con) : intersperse (Text " -> ") (zipWith ArgPos [0..] a ++ [ArgRes b])@@ -121,15 +135,15 @@ showModule = concat . intersperse "." instance Show Package where- show (Package a b c d) = unwords [a,b,c,d]+ show (Package a b c d) = unwords $ filter (/= "") [a,b,c,d] instance Show Module where- show (Module a b) = unwords [showModule a, "{" ++ show b ++ "}"]+ show (Module a) = showModule a instance Show Entry where- show (Entry a _ b _ _) = unwords [concatMap f b, m]+ show e = unwords [concatMap f $ entryText e, m] where- m = case a of+ m = case entryModule e of Nothing -> "" Just y -> "{#" ++ show (linkKey y) ++ "}" @@ -145,12 +159,12 @@ get = get4 Package instance BinaryDefer Module where- put (Module a b) = put2 a b- get = get2 Module+ put (Module a) = put1 a+ get = get1 Module instance BinaryDefer Entry where- put (Entry a b c d e) = put5 a b c d e- get = get5 Entry+ put (Entry a b c d e f g) = put7 a b c d e f g+ get = get7 Entry instance BinaryDefer EntryText where put (Keyword a) = putByte 0 >> put1 a@@ -168,5 +182,6 @@ 4 -> get1 ArgRes instance BinaryDefer EntryType where- put = put . fromEnum- get = liftM toEnum get+ put = putEnumByte+ get = getEnumByte+
+ src/Hoogle/Item/URL.hs view
@@ -0,0 +1,34 @@++module Hoogle.Item.URL where++import General.Code+import Hoogle.Item.Item+import Web.Text(escapeHTML) -- TODO: Shouldn't be importing this!+import Numeric+import Data.Binary.Defer.Index++++entryURL :: Entry -> String+entryURL e@Entry{entryType=EntryModule} = entryModuleURL e+entryURL e@Entry{entryType=EntryPackage} = entryPackageURL e+entryURL e@Entry{entryType=EntryOther} = entryModuleURL e ++ "#v:" ++ escapeHTML (entryName e)+entryURL e@Entry{entryType=EntryKeyword} =+ "http://www.haskell.org/haskellwiki/Keywords#" ++ concatMap f (entryName e)+ where+ f x | isAlpha x || x `elem` "_-:" = [x]+ | otherwise = '.' : map toUpper (showHex (ord x) "")+++entryModuleURL :: Entry -> String+entryModuleURL Entry{entryModule=Just m, entryPackage=p} | pkg /= "" =+ pkg ++ concat (intersperse "-" name) ++ ".html"+ where+ name = moduleName $ fromLink m+ pkg = haddockURL $ fromLink p+entryModuleURL _ = ""+++entryPackageURL :: Entry -> String+entryPackageURL e = if a == "" then b else a+ where Package{hackageURL=a, haddockURL=b} = fromLink $ entryPackage e
src/Hoogle/Operations/All.hs view
@@ -1,8 +1,10 @@ module Hoogle.Operations.All(+ module Hoogle.Operations.Combine, module Hoogle.Operations.Convert, module Hoogle.Operations.Rank ) where +import Hoogle.Operations.Combine import Hoogle.Operations.Convert import Hoogle.Operations.Rank
+ src/Hoogle/Operations/Combine.hs view
@@ -0,0 +1,11 @@++module Hoogle.Operations.Combine(combine) where++import General.Code+import Hoogle.DataBase.All+++combine :: [FilePath] -> FilePath -> IO ()+combine infiles outfile = do+ dbs <- mapM loadDataBase infiles+ saveDataBase outfile $ combineDataBase dbs
src/Hoogle/Operations/Convert.hs view
@@ -7,13 +7,14 @@ -- error messages are given using trace and error-convert :: Bool -> FilePath -> FilePath -> IO ()-convert debugCheck tb db = do+convert :: Bool -> [FilePath] -> FilePath -> FilePath -> IO ()+convert debugCheck deps tb db = do res <- parseTextBase tb case res of Left x -> error $ show x Right x -> do- let y = createDataBase x+ dbs <- mapM loadDataBase deps+ let y = createDataBase dbs x saveDataBase db y when (debugCheck) $ do
src/Hoogle/Operations/Rank.hs view
@@ -55,8 +55,8 @@ xs2 = zip ["f" ++ show i | i <- [1..]] xs res = searchAll [db] q- db = createDataBase $ tb ++ [(ItemFunc a b, "") | (a,b) <- xs2]- q = defaultQuery{typeSig=Just t}+ db = createDataBase [] $ tb ++ [(ItemFunc a b, "") | (a,b) <- xs2]+ q = blankQuery{typeSig=Just t} grab :: (String,TypeSig) -> (TypeSig,[Cost]) grab (name,typ) = (,) typ $
src/Hoogle/Query/Parser.hs view
@@ -22,12 +22,10 @@ | otherwise = x -blank = Query [] [] Nothing [] []--merge (Query a1 b1 c1 d1 e1) (Query a2 b2 c2 d2 e2) =- Query (a1++a2) (b1++b2) (c1 `mplus` c2) (d1++d2) (e1++e2)+merge (Query a1 b1 c1 d1) (Query a2 b2 c2 d2) =+ Query (a1++a2) (b1++b2) (c1 `mplus` c2) (d1++d2) -merges xs = foldr merge blank xs+merges xs = foldr merge blankQuery xs parsecQuery :: Parser Query@@ -36,15 +34,19 @@ end f = do x <- f; eof; return x names = do a <- many (flag <|> name)- b <- option blank (string "::" >> spaces >> types)- return (merge (merges a) b)+ b <- option blankQuery (string "::" >> spaces >> types)+ let res@Query{names=names} = merge (merges a) b+ (op,nop) = partition ((`elem` ascSymbols) . head) names+ if op /= [] && nop /= []+ then fail "Combination of operators and names"+ else return res - name = (do x <- operator ; spaces ; return blank{names=[x]})+ name = (do x <- operator ; spaces ; return blankQuery{names=[x]}) <|> (do xs <- keyword `sepBy1` (char '.') ; spaces return $ case xs of- [x] -> blank{names=[x]}- xs -> blank{names=[last xs],scope=[PlusModule (init xs)]}+ [x] -> blankQuery{names=[x]}+ xs -> blankQuery{names=[last xs],scope=[PlusModule (init xs)]} ) operator = between (char '(') (char ')') op <|> op@@ -54,8 +56,8 @@ types = do a <- flags b <- parsecTypeSig c <- flags- return $ merges [a,blank{typeSig=Just b},c]- + return $ merges [a,blankQuery{typeSig=Just b},c]+ flag = do x <- parseFlagScope ; spaces ; return x flags = many flag >>= return . merges @@ -67,7 +69,7 @@ -- /? (special case) -- +Data.Map parseFlagScope :: Parser Query-parseFlagScope = do x <- try scope <|> flag+parseFlagScope = do x <- try scope <|> try flag spaces return x where@@ -76,7 +78,7 @@ flag = do string "--" <|> string "/" name <- many1 letter <|> string "?" extra <- (do char '='; flagExtra) <|> (return "")- return blank{flags=[Flag (map toLower name) extra]}+ return blankQuery{flags=[Flag (map toLower name) extra]} where flagExtra = quoteStr <|> spaceStr quoteStr = between (char '\"') (char '\"') (many anyChar)@@ -87,13 +89,14 @@ aModule = if pm == '+' then PlusModule else MinusModule modu <- modname case modu of- [x] -> return $ blank{scope=[if isLower (head x) then aPackage x else aModule [x]]}- xs -> return $ blank{scope=[aModule xs]}+ [x] -> return $ blankQuery{scope=[if isLower (head x) then aPackage x else aModule [x]]}+ xs -> return $ blankQuery{scope=[aModule xs]} modname = keyword `sepBy1` (char '.') +-- TODO: Should share this definition with Hoogle.TypeSig.Parser keyword = do x <- letter- xs <- many $ satisfy (\x -> isAlphaNum x || x == '_')+ xs <- many $ satisfy (\x -> isAlphaNum x || x `elem` "_'#") return (x:xs)
src/Hoogle/Query/Render.hs view
@@ -3,6 +3,7 @@ import General.Code import Data.TagStr+import Data.Generics.Uniplate import Hoogle.Query.Type import Hoogle.TypeSig.All @@ -12,9 +13,11 @@ where namesig = case (null (names x), isNothing (typeSig x)) of (True, True) -> []- (True, False) -> showType+ (True, False) -> [Str ":: " | namelike] ++ showType (False, True) -> showName _ -> showName ++ [Str " :: "] ++ showType+ where namelike = and [isAlpha y || isSpace y | Str xs <- universe $ Tags showType+ , y:ys <- [dropWhile isSpace xs]] showName = intersperse (Str " ") $ map (TagBold . Str) (names x) showType = Str (showConstraint con) :
src/Hoogle/Query/Suggest.hs view
@@ -5,19 +5,53 @@ import General.Code import Hoogle.DataBase.All import Hoogle.Query.Type+import Hoogle.Query.Render+import Hoogle.TypeSig.All suggestQuery :: [DataBase] -> Query -> Maybe TagStr++-- They searched for Google (pay homage) suggestQuery db q | "google" `elem` map (map toLower) (names q) = Just $ Tags [TagHyperlink "http://www.google.com/" (Str "Google"), Str " rocks!"] +-- They searched for ?oogle (mock) suggestQuery db q | any f (names q) = Just $ Str "Can't think of anything more interesting to search for?" where f x = length x == 6 && "oogle" `isSuffixOf` x -suggestQuery db q | isJust $ typeSig q =- case suggestion db (fromJust $ typeSig q) of+-- They searched for "Int to Float", they meant "Int -> Float"+suggestQuery db q@Query{typeSig=Nothing, names=names} | "to" `elem` names = Just $ didYouMean q2+ where q2 = fixup db $ q{names = [] ,typeSig = Just $ TypeSig [] t2}+ t2 = TFun $ map (toApp . map toLitVar) $ split "to" $ names++-- They search for "Maybe a", did they mean ":: Maybe a"+suggestQuery db q@Query{typeSig=Nothing, names=names} | length names > 1 && all f names = Just $ didYouMean q2+ where q2 = fixup db $ q{names = [], typeSig = Just $ TypeSig [] $ toApp $ map toLitVar names}+ f (x:xs) = if null xs then isLower x else isUpper x++-- See what the type signature suggests from the database+suggestQuery db q@Query{typeSig=Just t} =+ case suggestion db t of Nothing -> Nothing- Just (Left s) -> Just $ Str s- Just (Right t) -> Just $ Str $ "Did you mean: " ++ show t+ Just (Left s) -> Just $ TagBold $ Str s+ Just (Right t) -> Just $ didYouMean $ q{typeSig = Just t} suggestQuery db q = Nothing++++didYouMean :: Query -> TagStr+didYouMean q = Tags [TagBold $ Str "Did you mean: ", TagHyperlink ("query:" ++ s) $ Str s]+ where s = showTagText $ renderQuery q+++fixup :: [DataBase] -> Query -> Query+fixup db q@Query{typeSig=Just t} =+ case suggestion db t of+ Just (Right t) -> q{typeSig=Just t}+ _ -> q+fixup db q = q+++toLitVar xs@(x:_) = if isLower x then TVar xs else TLit xs+toApp (x:xs) = TApp x xs
src/Hoogle/Query/Type.hs view
@@ -12,21 +12,20 @@ usefulQuery query = not (null (names query)) || isJust (typeSig query) -defaultQuery = Query [] [] Nothing [] []+blankQuery = Query [] [] Nothing [] data Query = Query { scope :: [Scope], names :: [String], typeSig :: Maybe TypeSig,- items :: [ItemType], flags :: [Flag] } deriving Show instance Eq Query where- (Query a1 b1 c1 d1 e1) == (Query a2 b2 c2 d2 e2) =- and [a1 `setEq` a2, b1 `setEq` b2, c1 == c2, d1 `setEq` d2, e1 `setEq` e2]+ (Query a1 b1 c1 d1) == (Query a2 b2 c2 d2) =+ and [a1 `setEq` a2, b1 `setEq` b2, c1 == c2, d1 `setEq` d2] data Scope = PlusPackage String@@ -37,20 +36,6 @@ isPlusModule (PlusModule _) = True; isPlusModule _ = False isMinusModule (MinusModule _) = True; isMinusModule _ = False---data ItemType = ItemModule- | ItemType- | ItemFunction- | ItemClass- deriving (Eq, Show, Read)--itemTypes =- [(["module"], ItemModule)- ,(["type","data"], ItemType)- ,(["function","ctor","fun"], ItemFunction)- ,(["class","instance"], ItemClass)- ] -- primarily for consoles, but some work on the web search
src/Hoogle/Search/Results.hs view
@@ -60,20 +60,20 @@ filterResults q = f mods correctModule . f pkgs correctPackage where f [] act = id- f xs act = filter (maybe True (act xs . fromLink) . entryModule . fromLink . resultEntry)+ f xs act = filter (act xs . fromLink . resultEntry) mods = filter (\x -> isPlusModule x || isMinusModule x) $ scope q pkgs = [x | MinusPackage x <- scope q] -- pkgs is a non-empty list of MinusPackage values-correctPackage :: [String] -> Module -> Bool-correctPackage pkgs = (`notElem` pkgs) . packageName . fromLink . modulePackage+correctPackage :: [String] -> Entry -> Bool+correctPackage pkgs = (`notElem` pkgs) . packageName . fromLink . entryPackage -- mods is a non-empty list of PlusModule/MinusModule-correctModule :: [Scope] -> Module -> Bool-correctModule mods = f base mods . moduleName+correctModule :: [Scope] -> Entry -> Bool+correctModule mods = maybe True (f base mods . moduleName . fromLink) . entryModule where base = isMinusModule $ head mods
src/Hoogle/TextBase/Parser.hs view
@@ -24,8 +24,7 @@ f com [] = [] f com ((i,s):is) | "-- | " `isPrefixOf` s = f [drop 5 s] is- | "-- " `isPrefixOf` s && com /= [] = f (drop 5 s:com) is- | "-- " `isPrefixOf` s = f [] is+ | "--" `isPrefixOf` s = f ([drop 5 s | com /= []] ++ com) is | all isSpace s = f [] is | otherwise = (case parse parsecTextItem file s of Left y -> Left $ setErrorPos (setSourceLine (errorPos y) i) y
src/Hoogle/TextBase/Type.hs view
@@ -2,6 +2,8 @@ module Hoogle.TextBase.Type where import Hoogle.TypeSig.All+import Data.Binary.Defer+import General.Code -- (the item, any haddock documentation)@@ -19,8 +21,34 @@ data DataKeyword = NewTypeKeyword | DataKeyword- deriving Eq+ deriving (Enum,Eq) instance Show DataKeyword where show NewTypeKeyword = "newtype" show DataKeyword = "data"+++instance BinaryDefer TextItem where+ put (ItemModule a ) = putByte 0 >> put1 a+ put (ItemClass a ) = putByte 1 >> put1 a+ put (ItemFunc a b) = putByte 2 >> put2 a b+ put (ItemAlias a b) = putByte 3 >> put2 a b+ put (ItemData a b) = putByte 4 >> put2 a b+ put (ItemInstance a ) = putByte 5 >> put1 a+ put (ItemAttribute a b) = putByte 6 >> put2 a b++ get = do+ x <- getByte+ case x of+ 0 -> get1 ItemModule+ 1 -> get1 ItemClass+ 2 -> get2 ItemFunc+ 3 -> get2 ItemAlias+ 4 -> get2 ItemData+ 5 -> get1 ItemInstance+ 6 -> get2 ItemAttribute+++instance BinaryDefer DataKeyword where+ put = putEnumByte+ get = getEnumByte
src/Hoogle/TypeSig/Parser.hs view
@@ -20,7 +20,7 @@ context = try acontext <|> return [] acontext = do x <- conitems <|> (conitem >>= return . (:[]))- white $ string "=>"+ white $ char '=' >> oneOf "#>" return x conitems = between (wchar '(') (wchar ')') $ conitem `sepBy1` (wchar ',')@@ -98,9 +98,11 @@ keysymbol = try $ do x <- many1 $ satisfy (\x -> isSymbol x || x `elem` ascSymbol)- if x `elem` ["::","=>",".","=","#",":","-","+","/","--"] then fail "Bad symbol" else- return $ if x == "-#" then "->" else x- ascSymbol = "!#$%&*+./<=>?@\\^|-~:"+ if x `elem` ["->","-#"] then return "->" -- fast shortcut for arrows+ else if x `elem` reservedSym then fail "Bad symbol"+ else return x+ ascSymbol = "->#!$%&*+./<=?@\\^|-~:"+ reservedSym = ["::","=>","=#",".","=","#",":","-","+","/","--"] optionBool p = (p >> return True) <|> return False
src/Hoogle/TypeSig/Type.hs view
@@ -80,18 +80,25 @@ --------------------------------------------------------------------- -- UNIPLATE INSTANCES -onTypeSig :: BiplateType TypeSig Type-onTypeSig (TypeSig xs x) = (x:xs, \(x:xs) -> TypeSig xs x)- instance Uniplate Type where uniplate (TApp x xs) = (x:xs, \(x:xs) -> TApp x xs) uniplate (TFun xs) = (xs, \xs -> TFun xs) uniplate x = ([], \[] -> x) +onTypeSig :: BiplateType TypeSig Type+onTypeSig (TypeSig xs x) = (x:xs, \(x:xs) -> TypeSig xs x)++transformSig = transformOn onTypeSig+universeSig = universeOn onTypeSig++ variables :: Type -> [String] variables x = [v | TVar v <- universe x] +variablesSig :: TypeSig -> [String]+variablesSig x = [v | TVar v <- universeSig x] + --------------------------------------------------------------------- -- BINARYDEFER INSTANCES @@ -127,10 +134,18 @@ instance Show Type where showsPrec i x = showString $ f i x where+ -- Show lists and tuples specially f i (TApp (TLit "[]") [x]) = "[" ++ show x ++ "]" f i (TApp (TLit ('(':tup)) xs) | not (null tup) && last tup == ')' && all (== ',') (init tup) && length tup == length xs = b True $ concat $ intersperse ", " $ map show xs++ -- Should parallel lists and unboxed tuples specially+ f i (TApp (TLit "[::]") [x]) = "[:" ++ show x ++ ":]"+ f i (TApp (TLit ('(':'#':tup)) xs)+ | "#)" `isSuffixOf` tup && all (== ',') (drop 2 $ reverse tup) && length tup - 1 == length xs+ = "(# " ++ (concat $ intersperse ", " $ map show xs) ++ " #)"+ f i (TLit x) = x f i (TVar x) = x
src/Test/Parse_Query.hs view
@@ -7,21 +7,30 @@ parse_Query = do let (===) = parseTest parseQuery+ q = blankQuery - "/info" === defaultQuery{flags = [Flag "info" ""]}- "--info" === defaultQuery{flags = [Flag "info" ""]}- "/?" === defaultQuery{flags = [Flag "?" ""]}- "/count=10" === defaultQuery{flags = [Flag "count" "10"]}- "map" === defaultQuery{names = ["map"]}- "concat map" === defaultQuery{names = ["concat","map"]}- "a -> b" === defaultQuery{typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))}- "(a b)" === defaultQuery{typeSig = Just (TypeSig [] (TApp (TVar "a") [TVar "b"]))}- "map :: a -> b" === defaultQuery{names = ["map"], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))}- "+Data.Map map" === defaultQuery{scope = [PlusModule ["Data","Map"]], names = ["map"]}- "a -> b +foo" === defaultQuery{scope = [PlusPackage "foo"], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))}- "a -> b /foo" === defaultQuery{flags = [Flag "foo" ""], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))}- "a -> b --foo" === defaultQuery{flags = [Flag "foo" ""], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))}- "Data.Map.map" === defaultQuery{scope = [PlusModule ["Data","Map"]], names = ["map"]}- "[a]" === defaultQuery{typeSig = Just (TypeSig [] (TApp (TLit "[]") [TVar "a"]))}- "++" === defaultQuery{names = ["++"]}- "(++)" === defaultQuery{names = ["++"]}+ "/info" === q{flags = [Flag "info" ""]}+ "--info" === q{flags = [Flag "info" ""]}+ "/?" === q{flags = [Flag "?" ""]}+ "/count=10" === q{flags = [Flag "count" "10"]}+ "map" === q{names = ["map"]}+ "#" === q{names = ["#"]}+ "c#" === q{names = ["c#"]}+ "-" === q{names = ["-"]}+ "/" === q{names = ["/"]}+ "->" === q{names = ["->"]}+ "foldl'" === q{names = ["foldl'"]}+ "fold'l" === q{names = ["fold'l"]}+ "Int#" === q{names = ["Int#"]}+ "concat map" === q{names = ["concat","map"]}+ "a -> b" === q{typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))}+ "(a b)" === q{typeSig = Just (TypeSig [] (TApp (TVar "a") [TVar "b"]))}+ "map :: a -> b" === q{names = ["map"], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))}+ "+Data.Map map" === q{scope = [PlusModule ["Data","Map"]], names = ["map"]}+ "a -> b +foo" === q{scope = [PlusPackage "foo"], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))}+ "a -> b /foo" === q{flags = [Flag "foo" ""], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))}+ "a -> b --foo" === q{flags = [Flag "foo" ""], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))}+ "Data.Map.map" === q{scope = [PlusModule ["Data","Map"]], names = ["map"]}+ "[a]" === q{typeSig = Just (TypeSig [] (TApp (TLit "[]") [TVar "a"]))}+ "++" === q{names = ["++"]}+ "(++)" === q{names = ["++"]}
src/Test/Parse_TypeSig.hs view
@@ -36,6 +36,7 @@ "Eq a => a" === TypeSig [TApp (TLit "Eq") [TVar "a"]] (TVar "a") "Class a b => a b" === TypeSig [TApp (TLit "Class") [TVar "a",TVar "b"]] (TApp (TVar "a") [TVar "b"]) "(Ord a, Eq b) => a -> b" === TypeSig [TApp (TLit "Ord") [TVar "a"],TApp (TLit "Eq") [TVar "b"]] (TFun [TVar "a",TVar "b"])+ "Eq a =# a" === TypeSig [TApp (TLit "Eq") [TVar "a"]] (TVar "a") -- forall "forall a . a -> a" === TypeSig [] (TFun [TVar "a", TVar "a"])
src/Web/Action.hs view
@@ -6,24 +6,66 @@ import Hoogle.Query.All import Hoogle.Item.All import Hoogle.Search.All+import Numeric import General.Code import System.IO.Unsafe(unsafeInterleaveIO) import Web.Page+import Web.Text import Text.ParserCombinators.Parsec import Data.TagStr import Data.Range import Data.Binary.Defer.Index+import Data.Generics.Uniplate +import Data.Time.Clock+import Data.Time.Calendar+import General.CGI(cgiArgs)+import Paths_hoogle + actionWeb :: CmdQuery -> IO () actionWeb q = do- (skipped,dbs) <- loadDataBases q- let res = unlines $ header (escapeHTML $ queryText q) ++ runQuery dbs q ++ footer+ logMessage q+ res <-+ if Mode "suggest" `elem` queryFlags q then do+ putStr "Content-type: application/json\n\n"+ runSuggest q+ else do+ putStr "Content-type: text/html\n\n"+ (skipped,dbs) <- loadDataBases q+ return $ unlines $ header (escapeHTML $ queryText $ queryPretty q) ++ runQuery dbs q ++ footer+ putStrLn res when (Debug `elem` queryFlags q) $ writeFile "temp.htm" res- putStrLn res+ sequence_ [writeFile x res | Output x <- queryFlags q] +-- TODO: Hacky, requires a better parser+-- Strip out Web, Debug and Output from queryText+queryPretty :: CmdQuery -> CmdQuery+queryPretty q = q{queryText = unwords $ filter f $ words $ queryText q}+ where f x = not $ any (`isPrefixOf` x) ["/debug","/output","/web"]+++logMessage :: CmdQuery -> IO ()+logMessage q = do+ time <- getCurrentTime+ cgi <- liftM (fromMaybe []) $ cgiArgs+ appendFile "log.txt" $ (++ "\n") $ unwords $+ [showGregorian (utctDay time)+ ,show (queryText q)] +++ ["?" ++ a ++ "=" ++ c ++ b ++ c | (a,b) <- cgi, let c = ['\"' | any isSpace b]]+++runSuggest :: CmdQuery -> IO String+runSuggest CmdQuery{query=Right Query{scope=[], names=[x], typeSig=Nothing}} = do+ root <- getDataDir+ db <- loadDataBase $ root </> "default.hoo"+ let res = take 8 $ completions db x+ return $ "[" ++ show x ++ "," ++ show res ++ "]"+runSuggest _ = return ""++ -- is the package not something that might go wrong safePackage :: String -> Bool safePackage = all $ \x -> isAlphaNum x || x `elem` "-_"@@ -36,7 +78,8 @@ loadDataBases CmdQuery{query=Right q} = do let pkgs = nub [x | PlusPackage x <- scope q, safePackage x] files = if null pkgs then ["default"] else pkgs- files <- filterM doesFileExist $ map (\x -> "res" </> x <.> "hoo") files+ root <- getDataDir+ files <- filterM doesFileExist $ map (\x -> root </> x <.> "hoo") files dbs <- unsafeInterleaveIO $ mapM loadDataBase files return ([], dbs) loadDataBases _ = return ([], [])@@ -51,7 +94,8 @@ ,"</p><p>" ," Error: " +& drop 1 (dropWhile (/= ':') $ show err) ++ "<br/>" ,"</p><p>"- ," For information on what queries should look like, see the user manual."+ ," For information on what queries should look like, see the"+ ," <a href='http://www.haskell.org/haskellwiki/Hoogle'>user manual</a>." ,"</p>" ] where@@ -59,41 +103,40 @@ post2 = if null post then concat (replicate 3 " ") else post -runQuery dbs q | not $ usefulQuery $ fromRight $ query q =- ["<h1><b>Welcome to Hoogle</b></h1>"- ,"<p>"- ," Hoogle is a Haskell API search engine, have fun!"- ,"</p>"- ]+runQuery dbs q | not $ usefulQuery $ fromRight $ query q = welcome runQuery dbs cq@CmdQuery{query = Right q, queryFlags = flags} = ["<h1>Searching for " ++ qstr ++ "</h1>"] ++- ["<p>" ++ showTagHTML sug ++ "</p>" | Just sug <- [suggestQuery dbs q]] +++ ["<p>" ++ showTagHTML (transform qurl sug) ++ "</p>" | Just sug <- [suggestQuery dbs q]] ++ if null res then ["<p>No results found</p>"]- else -- error $ show (length res, length pre, length now, length post) -+ else ["<table>"] ++- concatMap renderRes pre ++- insertMore (concatMap renderRes now) +++ concatMap (uncurry renderRes) pre +++ insertMore (concatMap (uncurry renderRes) now) ++ [moreResults | not $ null post] ++ ["</table>"] where start = headDef 0 [i-1 | Start i <- flags] count = headDef 20 [n | Count n <- flags]- res = searchRange (rangeStartCount 0 (start+count+1)) dbs q+ res = zip [0..] $ searchRange (rangeStartCount 0 (start+count+1)) dbs q (pre,res2) = splitAt start res (now,post) = splitAt count res2 - moreResults = "<tr><td></td><td><a href='" ++ urlMore ++ "' class='more'>Show more results</a></td></tr>"- urlMore = "?q=" +% queryText cq ++ "&start=" ++ show (start+count+1) ++ "#more"+ moreResults = "<tr><td></td><td><a href=\"" +& urlMore ++ "\" class='more'>Show more results</a></td></tr>"+ urlMore = "?hoogle=" +% queryText cq ++ "&start=" ++ show (start+count+1) ++ "#more" qstr = unwords $ ["<b>" +& n ++ "</b>" | n <- names q] ++ ["::" | names q /= [] && isJust (typeSig q)] ++ [showTagHTML (renderEntryText view $ renderTypeSig t) | Just t <- [typeSig q]] view = [ArgPosNum i i | i <- [0..10]] + qurl (TagHyperlink url x) | "query:" `isPrefixOf` url = TagHyperlink ("?hoogle=" +% drop 6 url) x+ qurl x = x ++ -- insert <a name=more> where you can insertMore :: [String] -> [String] insertMore [] = []@@ -104,60 +147,32 @@ f [] = [] -renderRes :: Result -> [String]-renderRes r =- [tr $ td "mod" modname ++ td "" (href urlItem $ showTagHTMLWith url text)- ,tr $ td "pkg" pkgname ++ td "doc" doc]+renderRes :: Int -> Result -> [String]+renderRes i r =+ [tr $ modname ++ td "ans" (href urlEnt $ showTagHTMLWith url text)+ ,tr $ pkgname ++ td "doc" docs] where- pkg = liftM (fromLink . modulePackage . fromLink) $ entryModule $ fromLink $ resultEntry r+ ent = fromLink $ resultEntry r (modu,text,_) = renderResult r- modname = maybe "" (href urlModule . showModule) modu- pkgname = maybe "" (href urlPkg . packageName) pkg- doc = takeWhile (/= '\n') $ showTagHTML $ renderHaddock $ entryDocs $ fromLink $ resultEntry r+ modname = td "mod" $ maybe "" (href urlMod . showModule) modu+ pkgname = td "pkg" $ href urlPkg $ packageName $ fromLink $ entryPackage ent - urlPkg = "http://hackage.haskell.org/packages/archive/" +? maybe "" packageName pkg +? "/latest/doc/html/"- urlModule = urlPkg +? concat (intersperse "-" $ fromMaybe [] modu) +? ".html"- urlItem = urlModule +? "#v:" +? escapeHTML (entryName $ fromLink $ resultEntry r)+ docs = ("<div id='d" ++ show i ++ "' class='shut'>" +++ "<a class='docs' onclick='return docs(" ++ show i ++ ")' href='" ++ urlEnt ++ "'></a>") +?+ (showTagHTML $ renderHaddock $ entryDocs ent) +?+ "</div>" - url (TagHyperlink _ x) = Just $ "</a><a href='" +& urlItem ++ "'>" ++ showTagHTML x ++- "</a><a class='dull' href='" +& urlItem ++ "'>"+ urlPkg = entryPackageURL ent+ urlMod = entryModuleURL ent+ urlEnt = entryURL ent++ url (TagHyperlink _ x)+ | null urlEnt = Just $ "<span class='a'>" ++ showTagHTML x ++ "</span>"+ | otherwise = Just $ "</a><a href='" +& urlEnt ++ "'>" ++ showTagHTML x +++ "</a><a class='dull' href='" +& urlEnt ++ "'>" url _ = Nothing tr x = "<tr>" ++ x ++ "</tr>" td c x = "<td" ++ (if null c then "" else " class='" ++ c ++ "'") ++ ">" ++ x ++ "</td>" href url x = if null url then x else "<a class='dull' href='" ++ url ++ "'>" ++ x ++ "</a>"----- | Only append strings if neither one is empty-(+?) :: String -> String -> String-a +? b = if null a || null b then [] else a ++ b---- | Escape the second argument before appending-(+&) :: String -> String -> String-a +& b = a ++ escapeHTML b--(+%) = (+&) -- CGI query string escaping---escapeHTML = concatMap f- where- f '\"' = """- f '<' = "<"- f '>' = ">"- f x = [x]---showTagHTML = showTagHTMLWith (const Nothing)---showTagHTMLWith :: (TagStr -> Maybe String) -> TagStr -> String-showTagHTMLWith f x = g x- where- g x | isJust (f x) = fromJust $ f x- g (Str x) = escapeHTML x- g (Tags xs) = concatMap g xs- g (TagBold x) = "<b>" ++ showTagHTML x ++ "</b>"- g (TagUnderline x) = "<i>" ++ showTagHTML x ++ "</i>"- g (TagHyperlink url x) = "<a href=\"" +& url ++ "\">" ++ showTagHTML x ++ "</a>"- g (TagColor i x) = "<span class='c" ++ show i ++ "'>" ++ showTagHTML x ++ "</span>"
src/Web/Page.hs view
@@ -1,15 +1,17 @@ -module Web.Page(header, footer) where+module Web.Page(header, footer, welcome) where +import Web.Text header query = ["<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"- ,"<html>"- ," <head>"+ ,"<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>"+ ," <head profile='http://a9.com/-/spec/opensearch/1.1/'>" ," <meta http-equiv='Content-Type' content='text/html; charset=iso-8859-1' />"- ," <title>" ++ query ++ " - Hoogle</title>"- ," <link type='text/css' rel='stylesheet' href='res/hoogle.css'>"- ," <link type='image/png' rel='icon' href='res/favicon.png'>"+ ," <title>" ++ (query +? " - ") ++ "Hoogle</title>"+ ," <link type='text/css' rel='stylesheet' href='res/hoogle.css' />"+ ," <link type='image/png' rel='icon' href='res/favicon.png' />"+ ," <link type='application/opensearchdescription+xml' rel='search' href='res/search.xml' title='Hoogle' />" ," <script type='text/javascript' src='res/hoogle.js'> </script>" ," </head>" ," <body onload='on_load()'>"@@ -18,18 +20,21 @@ links = ["<div id='links'>"+ ," <span id='plugin' style='display:none;'><a href='javascript:add_search()'>Search plugin</a> |</span>" ," <a href='http://www.haskell.org/haskellwiki/Hoogle'>Manual</a> |" ," <a href='http://www.haskell.org/'>haskell.org</a>" ,"</div>" ] search query =- ["<form action='?' method='get' id='search'>"- ," <a id='logo' href='http://haskell.org/hoogle/'>" ++- "<img src='res/hoogle.png' alt='Hoogle' />" ++- "</a>"- ," <input name='q' id='q' type='text' value=\"" ++ query ++ "\" />"- ," <input id='submit' type='submit' value='Search' />"+ ["<form action='.' method='get'>"+ ," <div id='search'>"+ ," <a id='logo' href='http://haskell.org/hoogle/'>" +++ "<img src='res/hoogle.png' alt='Hoogle' />" +++ "</a>"+ ," <input name='hoogle' id='hoogle' type='text' value=\"" ++ query ++ "\" />"+ ," <input id='submit' type='submit' value='Search' />"+ ," </div>" ,"</form>" ] @@ -39,3 +44,32 @@ ," </body>" ,"</html>" ]+++welcome =+ ["<h1><b>Welcome to Hoogle</b></h1>"+ ,"<p>"+ ," Hoogle is a Haskell API search engine, which allows you to search many standard Haskell libraries"+ ," by either function name, or by approximate type signature."+ ,"</p>"+ ,"<p id='example'>"+ ," Example searches:<br/>"+ ," " ++ search "map"+ ," " ++ search "(a -> b) -> [a] -> [b]"+ ," " ++ search "Ord a => [a] -> [a]"+ ," " ++ search "Data.Map.insert"+ ," <br/>Enter your own search at the top of the page."+ ,"</p>"+ ,"<p>"+ ," The <a href='http://www.haskell.org/haskellwiki/Hoogle'>Hoogle manual</a> contains more details,"+ ," including further details on search queries, how to install Hoogle as a command line application"+ ," and how to integrate Hoogle with Firefox/Emacs/Vim etc."+ ,"</p>"+ ,"<p>"+ ," I am very interested in any feedback you may have. Please "+ ," <a href='http://www-users.cs.york.ac.uk/~ndm/contact/'>email me</a>, or add an entry to my"+ ," <a href='http://code.google.com/p/ndmitchell/issues/list'>bug tracker</a>."+ ,"</p>"+ ]+ where+ search x = "<a href='?hoogle=" +% x ++ "'>" +& x ++ "</a><br/>"
+ src/Web/Text.hs view
@@ -0,0 +1,74 @@++module Web.Text where++import General.Code+import Data.TagStr+import Numeric+++-- | Only append strings if neither one is empty+(+?) :: String -> String -> String+a +? b = if null a || null b then [] else a ++ b++-- | Escape the second argument as HTML before appending+(+&) :: String -> String -> String+a +& b = a ++ escapeHTML b++-- | Escape the second argument as a CGI query string before appending+(+%) :: String -> String -> String+a +% b = a ++ escapeCGI b+++-- TODO: Should be somewhere else+escapeHTML = concatMap f+ where+ f '\"' = """+ f '<' = "<"+ f '>' = ">"+ f '&' = "&"+ f '\n' = "<br/>"+ f x = [x]++escapeCGI = concatMap f+ where+ f x | isAlphaNum x || x `elem` "-" = [x]+ | x == ' ' = "+"+ | otherwise = '%' : ['0'|length s == 1] ++ s+ where s = showHex (ord x) ""+++showTagHTML = showTagHTMLWith (const Nothing)+++showTagHTMLWith :: (TagStr -> Maybe String) -> TagStr -> String+showTagHTMLWith f x = g x+ where+ g x | isJust (f x) = fromJust $ f x+ g (Str x) = escapeHTML x+ g (Tags xs) = concatMap g xs+ g (TagBold x) = "<b>" ++ showTagHTML x ++ "</b>"+ g (TagUnderline x) = "<i>" ++ showTagHTML x ++ "</i>"+ g (TagHyperlink "" x) = g (TagHyperlink url x)+ where str = showTagText x+ url = if "http:" `isPrefixOf` str then str else "?hoogle=" +% str+ g (TagHyperlink url x) = "<a href=\"" +& url ++ "\">" ++ showTagHTML x ++ "</a>"+ g (TagColor i x) = "<span class='c" ++ show i ++ "'>" ++ showTagHTML x ++ "</span>"+++-- TODO: Should be in Data.TagStr?++-- TODO: Should only break on spaces+trimTags :: Int -> TagStr -> TagStr+trimTags n (Tags xs) = Tags $ f n xs+ where+ f n [] = []+ f n (x:xs) | m < n = x : f (n-m) xs+ | otherwise = [trimTags n x, Str "..."]+ where m = length (showTagText x)+trimTags n x | length (showTagText x) > n = Tags []+ | otherwise = x+++onStr :: (String -> String) -> TagStr -> TagStr+onStr f (Str x) = Str $ f x+onStr f x = x