packages feed

hoogle 4.2.43 → 5.0.19.0

raw patch · 157 files changed

Files

CHANGES.txt view
@@ -1,89 +1,218 @@-Changelog for Hoogle+Changelog for Hoogle (* = API change, @ = database format change) -4.2.43-    Allow haskell-src-exts-1.17-4.2.42-    #24, don't use code.galois.com-4.2.41-    #115, require warp-2.1 or above-4.2.40-    #107, fix the keywords URL moving-4.2.39-    #106, shake-0.15 compatibility-4.2.38+5.0.19, released 2026-01-19+    Migrate (half of) parsing from haskell-src-exts to ghc-lib-parser+    Support hyperlinks in search output+    Colorize search output+    Use --count when --info is passed+    Change DB format to fix sizeOf in instance Storable Fingerprint+    Do not force 'upgrade-insecure-requests' if we ourselves are running an HTTP server+    #411, switched to xdg directory and deprecated legacy location+    Require and support crypton-connection >= 0.4.1+5.0.18.4, released 2024-01-14+    Don't test on GHC 9.2 or earlier+    Fix up the output of /stats to account for API changes+    #380, move results before left anchors in tab focus order+5.0.18.3, released 2021-12-24+    Compatibility with aeson-2.0+5.0.18.2, released 2021-09-01+    Compatibility with extra-1.7.10+    #370, add --jsonl to produce JSON on separate lines+5.0.18.1, released 2020-12-27+    #365, add flag to disable network tests+5.0.18, released 2020-07-19+    #356, make server --haddock work better+@   #339, support enough names to index all of Hackage+    #353, remove leading latex comments+    #351, partially fixed ghc-pkg output parsing for GHC 8.8+5.0.17.15, released 2020-02-15+    #342, have --local flag generate a set with the directory name+    Consider packages in Stackage Nightly and LTS part of Stackage+    #338, add format=text to strip HTML from the JSON+5.0.17.14, released 2020-01-08+    #334, allow haskell-src-exts-1.23+    #333, disable Aelve Codesearch links+5.0.17.13, released 2019-12-07+    #331, make --count work with --json+    #332, support ?q= as well as ?hoogle= (since it used to be q)+    #330, work with more browsers when JavaScript is disabled+5.0.17.12, released 2019-11-02+    Allow haskell-src-exts-1.22+    #324, make unicode search work more+    #323, fix escaping in packages list (on the left)+5.0.17.11, released 2019-08-23+    #318, allow --json to get results JSON from the command line+5.0.17.10, released 2019-08-02+    #314, fix bad URL trying to access package on Hoogle with --local+    #311, fix an overflow with weight computations+    Fix up the /log page to avoid raising CSP errors+    Avoid raising error when you see a bad URL+    Make errors from the server be code 400 rather than 500+5.0.17.9, released 2019-05-30+    #306, fix a potential directory traversal bug+    #305, add a flag to disable security headers+5.0.17.8, released 2019-05-14+    #299, add some security-improving headers+    #298, use Blaze for constructing most HTML+5.0.17.7, released 2019-05-10+    Fix an XSS vulnerability, reported by @alexanderGugel+    #297, make Uses for packages point at reverse deps+    #261, add support for pattern synonyms+5.0.17.6, released 2019-03-27+    #291, optimise the log parsing (5x speedup)+    #289, change to use autofocus attribute+    Add --links flag to integrate with https://codesearch.aelve.com/+    Remove warning about type search+5.0.17.5, released 2019-01-27+*   #285, remove accidental API break in 5.0.17.4+    Lots of improvements in type search+5.0.17.4, released 2018-12-10+*   #285, change targetPackage/Module to be opaque+    Require haskell-src-exts-1.21+    #271, added FromJSON instance for Target+    #253, adds JSON pagination from query parameters+    Make sure <h1> works well in doc snippets+    #251, make sure transformers is more popular than mtl+    Require network-uri >= 2.6, don't require network+5.0.17.3, released 2018-04-17+    Require extra-1.6.6+    Fix the reported memory sizes+5.0.17.2, released 2018-03-16+    Remove support for GHC 7.10+    Require conduit-1.3.0+    #245, add support for GHC 8.4+5.0.17.1, released 2018-01-27+    #238, only identify the database by the first three version components+    #236, in --local mode replace file:// links in Haddock pages+5.0.17, released 2018-01-17+    Add lower bounds for time and bytestring+    #234, allow http-conduit-0.15+5.0.16, released 2018-01-03+    #232, allow haskell-src-exts-1.18-1.20+5.0.15, released 2017-12-12+    Allow haskell-src-exts-1.20+5.0.14, released 2017-11-28+    #228, add --datadir for overriding data directory on servers+    #223, don't break on foldl'+    #222, make sure all packages appear in the search+5.0.13, released 2017-07-30+    #219, treat the query "a->b" the same as "a -> b"+    #215, if a specified module/package is missing, give no results+    #220, start on port 8080 by default+    Rely on the fact ghc API is now on Hackage+    #217, fix the mode tag propagating to child links+5.0.12, released 2017-05-06+    #210, expose targetInfo and targetSearchDisplay+5.0.11, released 2017-05-02+    #209, add a defaultDatabaseLocation function+5.0.10, released 2017-04-17+    #205, change how the link URL is computed+    #206, put newer versions of a package first+5.0.9, released 2017-01-16+    #202, add --haddock functionality+5.0.8, released 2016-12-29+    #194, make --local work regardless of code page+5.0.7, released 2016-12-27+    #200, make sure the content-type is set properly+5.0.6, released 2016-11-30+    #196, make --local look for .cabal files as well+    Fix up Frege documentation generation+5.0.5, released 2016-11-24+    #193, support multiple --local flags+    #195, add --home flag to server mode+    Allow haskell-src-exts-1.19+5.0.4, released 2016-09-11+    #184, use file URLs for local docs+    #183, make --local look for .txt files recursively+5.0.3, released 2016-08-28+    #181, use the proper network constraints+    Avoid deprecated Aeson modules+5.0.2, released 2016-07-25+    Move to haskell-src-exts-1.18+5.0.1, released 2016-07-12+    #178, support the --link argument+    #178, add module names to results on the command line+    #177, require containers 0.5 or above+5.0, released 2016-06-24+    #172, make sure --local links work on Linux+    #116, store data files in getAppUserDataDirectory by default+    G472, be robust to corrupt Hoogle files+    G521, make sure it works with inverted color preferences+    Rewrite from scratch+4.2.38, released 2015-01-28     #96, allow certicate verification failures     #95, allow a higher version of Cabal on older GHCs-4.2.37+4.2.37, released 2015-01-13     #94, GHC 7.10 support-4.2.36+4.2.36, released 2014-10-12     #85, add support for missing type constructors-4.2.35+4.2.35, released 2014-09-15     Allow haskell-src-exts-1.16-4.2.34+4.2.34, released 2014-07-09     Add defaultDatabaseLocation-4.2.33+4.2.33, released 2014-06-15     Allow WAI-3.0-4.2.32+4.2.32, released 2014-04-14     Allow haskell-src-exts-1.15-4.2.31+4.2.31, released 2014-04-03     #61, support conduit-1.1-4.2.30+4.2.30, released 2014-03-23     #57, support QuickCheck-2.7-4.2.29+4.2.29, released 2014-02-23     #55, if reading as UTF8 fails, explicitly try Latin1     Add QuickCheck as a dependency     Change createDatabase to also save the file     Disable rank feature     Remove running a hoogle query without converting the database     Ignore packages without documentation to hoogle data-4.2.28+4.2.28, released 2014-01-03     Upgrade to shake-0.11     #49, update "hoogle data" to be incremental-4.2.27+4.2.27, released 2014-01-01     Rewrite how "hoogle data" works     #45, if you are building all, also depend on default     #47, switch to using Shake to build the recipes     Add a dependency on Shake-4.2.26+4.2.26, released 2013-12-10     Fix omission of the Test file-4.2.25+4.2.25, released 2013-12-09     Fix timestamps in .tar.gz dist file-4.2.24+4.2.24, released 2013-12-08     Allow WAI 2.0     Fix the Keyword generator-4.2.23+4.2.23, released 2013-09-29     Improvements to Haddock conversion-4.2.22+4.2.22, released 2013-09-29     Download Hoogle data from the old Hackage server-4.2.21+4.2.21, released 2013-09-01     #25, make the tarball pass the tests     #26, GHC 7.8 compatibility     Ensure alias resolution is bottom-up and recursive-4.2.20+4.2.20, released 2013-08-25     #619, do not depend on unix on Windows-4.2.19+4.2.19, released 2013-08-20     Fix version bounds-4.2.18+4.2.18, released 2013-08-20     Allow bytestring-0.9-4.2.17+4.2.17, released 2013-08-20     Upgrade to haskell-src-exts-1.14     Visual redesign     Require bytestring-0.10 or above, due to NFData instances     Add NFData instance to Database-4.2.16+4.2.16, released 2013-02-21     Remove lots of explicit upper bounds-4.2.15+4.2.15, released 2013-01-29     Allow http-types-0.8     Allow case-insensitive-1.0     Support --local for GHC docs     #568, rewrite Haddock links in --local-4.2.14+4.2.14, released 2012-11-06     Switch license from GPL to BSD3     GHC 7.6 fixes     ##4, Allow Cabal-1.16.*-4.2.13+4.2.13, released 2012-08-18     Allow cmdargs-0.10.*-4.2.12+4.2.12, released 2012-07-15     Allow conduit-0.5, wai-1.3 and warp-1.3     Upgrade to http-types-0.7.*     In embedded mode, don't hijack the URL bar or title@@ -93,41 +222,41 @@     Improve iPhone support     Update the copyright year in the footer     Double the speed of hoogle server responses-4.2.11+4.2.11, released 2012-04-05     Allow transformers-0.3     Allow conduit-0.4, wai-1.2 and warp-1.2     Allow haskell-src-exts-1.12 and 1.13-4.2.10+4.2.10, released 2012-03-04     #533, be paranoid when parsing Cabal files-4.2.9+4.2.9, released 2012-03-01     Upgrade to WAI-1.1 and Warp-1.1     #525, don't rely on a redirect to find files     Allow Cabal-1.14-4.2.8+4.2.8, released 2011-11-27     Allow cmdargs-0.9     Fix setting the global read flags and unsetting them properly     Allow case-insensitive-0.4.*     Make data --local have a good default on Linux     Make server --local work on Windows     #407, rewrite OpenSearch plugin to work regardless of the server-4.2.7+4.2.7, released 2011-09-03     Allow cmdargs-0.8-4.2.6+4.2.6, released 2011-08-12     Permit GHC 7.2     Allow case-insensitive-0.3.*     Fix bug when searching for toString in the embed mode     Make --redownload work on the tarballs-4.2.5+4.2.5, released 2011-06-12     Fix hyperlinks to symbols (i.e. &&) in Haddock-4.2.4+4.2.4, released 2011-05-26     #434, use either wget or curl to download the files     Allow haskell-src-exts 1.11.*     Upgrade to cmdargs==0.7.*-4.2.3+4.2.3, released 2011-05-01     Generate database for ghc internals     Give an error if the database is the wrong version     Add -fno-cse, to make cmdargs work (was losing args annotations)-4.2.2+4.2.2, released 2011-04-25     Upgrade to WAI==0.4.* and Warp==0.4.*     Allow parsec 3, since various people have reported it works     Default module URL's correctly when not on Hackage@@ -144,14 +273,14 @@     Make package matching case insensitive     #372, add features to improve module name search     Make module name searching case insensitive-4.2.1+4.2.1, released 2011-01-26     Fix for pattern match failure when searching for "to"     Fix for not sending text/html when serving local files     Eliminate the --nostdin flag, now unnecessary     Change to use WAI/Warp instead of HTTP and custom server     Fix a bug, didn't ever show Waiting... on the real website     Make embed work in IE8-4.2+4.2, released 2011-01-23     Make the CGI interface send the right number of newlines     Accept prefix and suffix web parameters     Eliminate isBlankQuery, make Query a Monoid@@ -162,7 +291,7 @@     Ignore some whitespace in the input file     Work around a cabal bug, include jquery.cookie.js     Add ?version=xxx to .css and .js, to make it auto refresh-4.1.5+4.1.5, released 2011-01-16     #399, rehabilitate mode=suggest     Stop mode=suggest failing entirely, now cleanly gives no answers     Combine --web and --webmode@@ -173,24 +302,24 @@     #54, rework packages, entries and keywords     #87, make all database files lowercase     Various javascript/ajax enhancements-4.1.4+4.1.4, released 2011-01-15     Running data on Posix sets all files to global read/execute     Relax haskell-src-exts to allow 1.10.1     Rework the web page display further-4.1.3+4.1.3, released 2011-01-09     Read and write all database files in UTF8     #391, add tar -xzf when extracting from the tarball     Change search results display, packages/modules on separate line     Exclude haskellN* from the platform, they are in base     Add --nostdin to server mode, to support running with nohup     Loosen dependencies for tagsoup (typo'd it before)-4.1.2+4.1.2, released 2010-12-19     Loosen dependencies for tagsoup and HTTP (but not parsec)     Avoid self circular dependencies-4.1.1+4.1.1, released 2010-12-18     #195, include all the necessary resources to run as a server     When in server mode, be more robust to errors-4.1+4.1, released 2010-12-18     #320, make sure system is found     #146, preserve forall's in everywhere     #186, switch to using haskell-src-exts to parse input files@@ -208,5 +337,5 @@     #51, test mode now does what test and testfile did     #66, turn Hoogle into a library     Add --server flag, to run as a server-4.0.7+4.0.7, released 2009-07-19     Start of changelog
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Neil Mitchell 2004-2026.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Neil Mitchell nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
README.md view
@@ -1,22 +1,21 @@-# Hoogle [![Hackage version](https://img.shields.io/hackage/v/hoogle.svg?style=flat)](https://hackage.haskell.org/package/hoogle) [![Build Status](https://img.shields.io/travis/ndmitchell/hoogle.svg?style=flat)](https://travis-ci.org/ndmitchell/hoogle)--**NOTE: This code branch contains the code for the Hoogle v4 series. The `master` branch contains the code for the current Hoogle v5 series.**+# Hoogle [![Hackage version](https://img.shields.io/hackage/v/hoogle.svg?label=Hackage)](https://hackage.haskell.org/package/hoogle) [![Stackage version](https://www.stackage.org/package/hoogle/badge/nightly?label=Stackage)](https://www.stackage.org/package/hoogle) [![Build status](https://img.shields.io/github/actions/workflow/status/ndmitchell/hoogle/ci.yml?branch=master)](https://github.com/ndmitchell/hoogle/actions) -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. To experiment, visit the online version at http://haskell.org/hoogle.+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. The online version can be found at https://hoogle.haskell.org/ and searches [Stackage](https://www.stackage.org/). -* **Online version:** http://haskell.org/hoogle-* **Hackage page:** http://hackage.haskell.org/packages/hoogle-* **Source code:** http://github.com/ndmitchell/hoogle-* **Bug tracker:** http://code.google.com/p/ndmitchell/issues/list+* **Online version:** https://hoogle.haskell.org/+* **Hackage page:** https://hackage.haskell.org/package/hoogle+* **Source code:** https://github.com/ndmitchell/hoogle+* **Bug tracker:** https://github.com/ndmitchell/hoogle/issues  ## Hoogle Use  Hoogle can be used in several ways: -* **Online**, with the web interface at http://haskell.org/hoogle-* **In [IRC](http://haskell.org/haskellwiki/Haskell_IRC_channel)**, using the [Lambdabot](http://haskell.org/haskellwiki/Lambdabot) plugin with `@hoogle` and `@hoogle+`-* **[Installed locally](docs/Local-Install.md)**, with either a command line or in a browser-* **[As a developer](docs/Developers.md)**, through Haskell or JSON APIs.+* **Online**, with the web interface at https://hoogle.haskell.org/+* **In [IRC](https://wiki.haskell.org/IRC_channel)**, using the [Lambdabot](https://wiki.haskell.org/Lambdabot) plugin with `@hoogle` and `@hoogle+`+* **From `emacs`**, by means of [`engine-mode`](https://github.com/hrs/engine-mode)+* **[Installed locally](./docs/Install.md)**, with either a command line or in a browser+* **[As a developer](./docs/API.md)**, through Haskell or JSON APIs.  # Searches @@ -34,7 +33,7 @@  ## Scope -By default, searches look at the [Haskell Platform](http://hackage.haskell.org/platform) and [Haskell keywords](http://haskell.org/haskellwiki/Keywords). However, all [Hackage](http://hackage.haskell.org) packages are available to search. As some examples:+By default, searches look at the [Haskell Platform](https://www.haskell.org/platform/) and [Haskell keywords](https://wiki.haskell.org/Keywords). However, all [Stackage](https://stackage.org) packages are available to search. As some examples:  * `mode +cmdargs` searches only the "cmdargs" package * `file -base` searches the Haskell Platform, excluding the "base" package@@ -53,82 +52,92 @@  To invoke Hoogle type: -    hoogle "[a] -> [b]"+    $ hoogle "[a] -> [b]"  Note the quotes, otherwise you will redirect the output to the file [b].  To ensure you have data files for the Hackage modules, you will first need to type: -    hoogle data+    $ hoogle generate  Which will download and build Hoogle databases. -## Chrome Integration+## Command Line UI -**As a keyword search:** With a keyword search you can type `h map` directly into the location bar to perform a Hoogle search. Go to the [Hoogle website](http://haskell.org/hoogle/) in Chrome, right-click in the Hoogle search field and select "Add as a search engine...". Give it a keyword such as "h".+There is a terminal/curses based UI available through [`cabal install bhoogle`](https://hackage.haskell.org/package/bhoogle). +## Chrome Integration +**As a keyword search:** With a keyword search you can type `h map` directly into the location bar to perform a Hoogle search. Go to the [Hoogle website](https://hoogle.haskell.org/) in Chrome, right-click in the Hoogle search field and select "Add as a search engine...". Give it a keyword such as "h".+ ## Firefox Integration -**From the search bar:** Go to the [Hoogle website](http://haskell.org/hoogle/) in Firefox and click on the drop-down arrow at the left of the search bar, and select the "Add Hoogle" option. Click the arrow again to select Hoogle as your search engine.+**From the search bar:** Go to the [Hoogle website](https://hoogle.haskell.org/) in Firefox and click on the `⋯` symbol at the right of the URL bar, and select the "Add Search Engine" option. Click the hoogle logo at the bottom of the completion dropdown when searching to perform a Hoogle search. -**As a keyword search:** With a keyword search you can type `h map` directly into the location bar to perform a Hoogle search. Go to the [Hoogle website](http://haskell.org/hoogle/) in Firefox, right-click in the Hoogle search field and select "Add a Keyword for this Search...". Given it a keyword such as "h".+**As a keyword search:** With a keyword search you can type `h map` directly into the location bar to perform a Hoogle search. Go to the [Hoogle website](https://hoogle.haskell.org/) in Firefox, right-click in the Hoogle search field and select "Add a Keyword for this Search...". Given it a keyword such as "h". -If you want to search for special symbols in Firefox keyword search, modify the keyword search URL to be: `javascript:window.location.href="http://haskell.org/hoogle?q=" + encodeURIComponent("%s")`+## Others +* [Doc Browser](https://github.com/qwfy/doc-browser) -## Firefox Ubiquity Integration+### The Source Code -[Ubiquity](https://wiki.mozilla.org/Labs/Ubiquity) provides a graphical command-line for Firefox. To install the Ubiquity Hoogle command, visit the [this page](http://www.randomhacks.net/git/ubiquity/hoogle/) and click "Subscribe..." when asked whether you want to install it. Further information is available [here](http://www.randomhacks.net/articles/2008/09/01/ubiquitous-hoogle).+    $ git clone https://github.com/ndmitchell/hoogle.git +Contributions are most welcome. Hoogle is written in Haskell 98 + Heirarchical Modules, I do not wish to change this. Other than that, I'm pretty flexible about most aspects of Hoogle. The [issue tracker](https://github.com/ndmitchell/hoogle/issues) has many outstanding tasks, but please contact me if you have thoughts on doing something major to Hoogle, so I can give some advice.  # Background -Hoogle work is licensed under the [GPL version 2.0](https://github.com/ndmitchell/hoogle/blob/master/docs/LICENSE). Any patches are assumed to be dual licensed under the BSD license and the GPL, to allow re-licensing Hoogle under the BSD license in future, if that proves beneficial to the Haskell community. The work is intended to be helpful, open and free. If the license doesn't meet your needs then talk to me.+Hoogle work is licensed under the [BSD-3-Clause license](https://github.com/ndmitchell/hoogle/blob/master/LICENSE).  ## Theoretical Foundations  A lot of related work was done by Rittri [1] and Runciman [2] in the late 80's. Since then Di Cosmo [3] has produced a book on type isomorphisms. Unfortunately the implementations that accompanied the earlier works were for functional languages that have since become less popular. -1. [Mikael Rittri, Using Types as Search Keys in Function Libraries](http://portal.acm.org/citation.cfm?id=99384). Proceedings of the fourth international conference on Functional Programming languages and Computer Architecture: 174-183, June 1989.-2. [Colin Runciman and Ian Toyn, Retrieving reusable software components by polymorphic type](http://portal.acm.org/citation.cfm?id=99383). Journal of Functional Programming 1 (2): 191-211, April 1991.-3. [Roberto Di Cosmo, Isomorphisms of types: from lambda-calculus to information retrieval and language design](http://www.pps.jussieu.fr/~dicosmo/Publications/ISObook.html). Birkhauser, 1995. ISBN-0-8176-3763-X+1. [Mikael Rittri, Using Types as Search Keys in Function Libraries](https://doi.org/10.1145/99370.99384). Proceedings of the fourth international conference on Functional Programming languages and Computer Architecture: 174-183, June 1989.+2. [Colin Runciman and Ian Toyn, Retrieving reusable software components by polymorphic type](https://doi.org/10.1145/99370.99383). Journal of Functional Programming 1 (2): 191-211, April 1991.+3. [Roberto Di Cosmo, Isomorphisms of types: from lambda-calculus to information retrieval and language design](https://doi.org/10.1145/270563.571468). Birkhauser, 1995. ISBN-0-8176-3763-X -I have given several presentations on type searching all available from [my home page](http://community.haskell.org/~ndm/hoogle).+I have given several presentations on type searching all available from [my home page](https://ndmitchell.com/). -## Folders+## Project Structure -The folders in the distribution, and their meaning are:+The folders in the repository, and their meaning are: -data - tools to generate a hoogle data file-docs - documentation on hoogle-misc - presentations, icons, emacs scripts, logos-src  - source code-web  - additional resources for the web front end (css, jpg etc.)+cbits             - C implementation of the text search used by hoogle +docs              - documention on hoogle++html              - resources for hoogle's web front-end (html, css, javascript, images, etc.)++misc              - scripts, logos, sample data, etc.++src               - haskell source code+ ## Similar Tools  I was unaware of any similar tools before starting development, and no other tool has really influenced this tool (except the first on this list). Some related tools are: -* [Google](http://www.google.com/), the leader in online search-* [Hayoo](http://holumbus.fh-wedel.de/hayoo/hayoo.html), similar to Hoogle, but with less focus on type search-* [Krugle](http://www.krugle.com/), search code, but no Haskell :(+* [Google](https://www.google.com/), the leader in online search+* [Hayoo](https://hackage.haskell.org/package/Hayoo), similar to Hoogle, but with less focus on type search+* [Krugle](https://www.krugle.com/), search code, but no Haskell :(+* [Cloogle](https://cloogle.org), for the [Clean](https://clean.cs.ru.nl/Clean) language   ## Acknowledgements -All code is all &copy; [Neil Mitchell](http://community.haskell.org/~ndm/), 2004-present. The initial version was done over my summer holiday, and further work was done during my PhD. During Summer 2008 I was funded to full-time on Hoogle by [Google Summer of Code](http://code.google.com/soc/) with the [haskell.org](http://haskell.org/) mentoring organisation. Since then I have been working on Hoogle in my spare time. Various people have given lots of useful ideas, including my PhD supervisor [Colin Runciman](http://www.cs.york.ac.uk/~colin/), and various members of the [Plasma group](http://www.cs.york.ac.uk/plasma/). In addition, the following people have also contributed code or significant debugging work:+All code is all &copy; [Neil Mitchell](https://ndmitchell.com/), 2004-present. The initial version was done over my summer holiday, and further work was done during my PhD. During Summer 2008 I was funded to full-time on Hoogle by [Google Summer of Code](https://summerofcode.withgoogle.com/) with the [haskell.org](https://www.haskell.org/) mentoring organisation. Since then I have been working on Hoogle in my spare time. Various people have given lots of useful ideas, including my PhD supervisor [Colin Runciman](https://www-users.cs.york.ac.uk/~colin/), and various members of the [Plasma group](https://www.cs.york.ac.uk/plasma/wiki/). In addition, the following people have also contributed code or significant debugging work: -* [Thomas "Bob" Davie](http://www.cs.kent.ac.uk/people/rpg/tatd2/)-* [Don Stewart](http://www.cse.unsw.edu.au/~dons/)+* Thomas "Bob" Davie+* Don Stewart * Thomas Jager-* [Gaal Yahas](http://gaal.livejournal.com/)-* [Mike Dodds](http://www-users.cs.york.ac.uk/~miked/)-* [Niklas Broberg](http://www.cs.chalmers.se/~d00nibro/)+* [Gaal Yahas](https://gaal.livejournal.com/)+* Mike Dodds+* Niklas Broberg * Esa Ilari Vuokko * Udo Stenzel-* [Henk-Jan van Tuyl](http://members.chello.nl/hjgtuyl/)+* [Henk-Jan van Tuyl](https://github.com/HJvT) * Gwern Branwen * Tillmann Rendel * David Waern@@ -140,3 +149,8 @@ * [Alfredo Di Napoli](http://www.alfredodinapoli.com)  In previous versions, all the data was taken from [Zvon's Haskell Guide](http://www.zvon.org/other/haskell/Outputglobal/). Thanks to their open and friendly policy of allowing the data to be reused, this project became possible. More recent versions use the Hierarchical Libraries as distributed with GHC, and databases generated by Haddock.++# Interesting links++* https://atom.io/packages/haskell-hoogle+* https://hackage.haskell.org/package/hoogle-index
+ cbits/include.h view
@@ -0,0 +1,3 @@++int text_search(char* haystack, char** needles, int exact, int* results);+int text_search_bound(char* xs);
+ cbits/text_search.c view
@@ -0,0 +1,133 @@+#include <stdlib.h>+#include <string.h>+++int min_int(int a, int b){return a > b ? b : a;}+int max_int(int a, int b){return a < b ? b : a;}++int maximum_int(int xs[], int n)+{+    int mx = 0;+    for (int i = 0; i < n; i++)+        mx = max_int(mx, xs[i]);+    return mx;+}+++// Given a list of words, separated by 0 and ending with two 0+// Find the character that occurs in most words, and return the count of it+int text_search_bound(char* xs)+{+    int counts[256];         // number of words I've seen each char in+    int poss[256];           // position I saw last char at+    int pos = 0;             // the current position I am at++    for (int i = 0; i < 256; i++)+    {+        counts[i] = 0;+        poss[i] = -1;+    }++    for (char* cs = xs; ; cs++)+    {+        unsigned char c = *cs;+        if (c == 0)+        {+            if (cs[1] == 0) break;+            pos++;+        }+        else if (poss[c] != pos)+        {+            poss[c] = pos;+            counts[c]++;+        }+    }+    return maximum_int(counts, 256);+}+++int count_pointers(char** xs)+{+    int i;+    for (i = 0; xs[i] != NULL; i++)+        ;+    return i;+}++int compare_int(const void *a, const void *b)+{+  const int *da = (const int*) a;+  const int *db = (const int*) b;++  return (*da > *db) - (*da < *db);+}+++// Taken from http://stackoverflow.com/questions/23999797/implementing-strnstr/24000056#24000056+char* memmem_(char* haystack, size_t hlen, char* needle, size_t nlen)+{+    if (nlen == 0) return haystack; // degenerate edge case+    if (hlen < nlen) return 0; // another degenerate edge case+    char *hlimit = haystack + hlen - nlen + 1;+    while ((haystack = memchr(haystack, needle[0], hlimit-haystack)))+    {+        if (!memcmp(haystack, needle, nlen)) return haystack;+        haystack++;+    }+    return 0;+}+++// haystack is \0 (space if leading upper) (lowercase string), ends with two \0+// needles are a NULL terminated list of lowercase strings, with a leading space if upper+int text_search(char* haystack, char** needles, int exact, int* results)+{+    // information about the needles+    int n = count_pointers(needles);+    int uppers[n];        // is this needle uppercase prefix+    int lengths[n];       // length of this needle+    char* strings[n];     // actual text of this needle++    for (int i = 0; i < n; i++)+    {+        uppers[i] = needles[i][0] == ' ';+        strings[i] = uppers[i] ? &needles[i][1] : needles[i];+        lengths[i] = strlen(strings[i]);+    }++    int index = 0;          // Number of \n's I've already seen in haystack+    int found = 0;          // Number I've written to results++    for (index = 0; ; index++)+    {+        int upper = haystack[0] == ' ';+        if (upper) haystack++;+        int length = strlen(haystack);+        if (length == 0) break;+        char* string = haystack;+        haystack = &haystack[length+1];++        int score = 4;+        for (int i = 0; i < n; i++)+        {+            char* pos = strstr(string, strings[i]); // length, strings[i], lengths[i]);+            if (pos == NULL)+            {+                score = -1;+                break;+            }+            else if (pos == string)+            {+                int complete = lengths[i] == length;+                int cased = uppers[i] == upper;+                score = min_int(score, (!complete ? 2 : 0) + (!cased ? 1 : 0));+            }+        }+        if (score >= 0 && (!exact || score == 0))+            results[found++] = (score << 24) | index;+    }+    qsort(results, found, sizeof(int), compare_int);+    for (int i = 0; i < found; i++)+        results[i] = results[i] & 0xffffff;+    return found;+}
− datadir/examples.txt 
@@ -1,76 +0,0 @@--- these tests use all the databases---- check ~ is found, bug #280-~ +keyword -n1-keyword ~---- check keywords are including in default-~ -n1-keyword ~---- check that keyword links work, bug #309-! --link +keyword -n1-keyword ! -- http://wiki.haskell.org/Keywords#.21---- check you find forall, bug #235-forall -n10-keyword forall---- check you find MonadWriter, bug #249-MonadWriter +mtl -n1-class (Monoid w, Monad m) => MonadWriter w m--module -n10-keyword module--Prelude -n1-Prelude--even +base -n1-even--tan +base -n1-tan--+base log -n1-log--seq +base -n1-seq---- test that the base type String=[Char] alias is known-"[Char] -> a -> a" -n1-@now trace---- test that packages are included-hlint -n1-package hlint---- #146, preserve foralls-everywhere +syb -n1-everywhere :: (forall a. Data a => a -> a) -> (forall a. Data a => a -> a)---- #320, make sure it finds system-system -n10-System.Cmd system :: String -> IO ExitCode---- #187, LT not found-LT +base -n1-LT :: Ordering---- #327, utf8 not found-utf8 -n1-utf8---- check that URL's work->>= --link -n1-http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html#v:-62--62--61---False --link -n1-http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html#v:False--Ord --link -n1-http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html#t:Ord--String --link -n1-http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html#t:String
− datadir/rank.txt 
@@ -1,66 +0,0 @@--- a list of examples--- used to generate a scoring system--@package rank-module Rank-type String = [Char]-type FilePath = String---@rank Ord a => [a] -> [a]-Ord a => a -> [a] -> [a]-[a] -> [a]-a -> [a] -> [a]--@rank Ord a => [a] -> [a]-[a] -> [a]-Int -> [a] -> [a]-String -> String-Int -> [Char] -> [Char]--@rank Ord a => [a] -> [a]-[a] -> [a]-Ord a => a -> [a]--@rank [a] -> [b]-(a -> b) -> [a] -> [b]-[a] -> [a]-Eq a => [a] -> [a]--@rank Int -> Bool-a -> Int -> Bool-a -> Bool--@rank a -> a-Int -> a -> a-a -> m a-a -> b--@rank a -> b-a -> b-a -> b -> a-a -> a-Int -> a--@rank [a] -> a-[a] -> Int -> a-Ord a => [a] -> a-[a] -> Bool--@rank a -> b -> c-a -> b -> c -> d-Int -> b -> c-a -> a -> a-Ord a => a -> a -> a--@rank String-[Char]-FilePath-a -> String--@rank [(a,b)] -> a -> b-[(a,b)] -> a -> b-a -> [(a,b)] -> b-Eq a => [(a,b)] -> a -> b-[(a,b)] -> a -> Maybe b-Eq a => a -> [(a,b)] -> Maybe b
− datadir/resources/favicon.ico

binary file changed (318 → absent bytes)

− datadir/resources/favicon.png

binary file changed (422 → absent bytes)

− datadir/resources/favicon57.png

binary file changed (1272 → absent bytes)

− datadir/resources/favicon64.png

binary file changed (1307 → absent bytes)

− datadir/resources/hoogle.css 
@@ -1,350 +0,0 @@-/********************************************************************-*  GENERAL ELEMENTS-*/--html {-    height: 100%;-}--body {-    margin: 0px;-    padding: 0px;-    font-family: sans-serif;-    font-size: 13px;-    position: relative;-    min-height: 100%;-}--a img {-    padding: 0px;-    margin: 0px;-    border: 0px;-}--a:hover {-    background-color: #ffb;-}--a {-    color: #C4451D;-    text-decoration: none;-}--.push {-    height: 4em;-}--/********************************************************************-*  TOP - LINKS AND SEARCH-*/--#links {-    position: relative;-    background: none repeat scroll 0 0 #293845;-    border-top: 5px solid #4E6272;-    color: #DDDDDD;-    text-align: right;-    padding: 0.2em;-}--#top-menu {-    display: inline-table;-    list-style: none outside none;-    margin: 0 0 0 1em;-    text-align: left;-}--#top-menu li {-    border-left: 1px solid #D5D5D5;-    display: inline;-    padding: 0;-    white-space: nowrap;-}--#top-menu li a,-#top-menu li a:link, -#top-menu li a:visited {-    font-size: 85%;-    color: white;-    text-decoration: none;-    padding: 0.2em 0.5em;-}--#top-menu li a:hover {-    background-color: #4e6272;-    text-decoration: underline;-}--form {-    margin-bottom: 0px;-}--#logo img {-    vertical-align: bottom;-}--#hoogle, #submit {-    font-size: 16px;-    margin-bottom: 16px;-    vertical-align: bottom;-}--#hoogle {-    width: 300px;-    margin-right: 5px;-    margin-left: 5px;-}--#submit {-    padding-left: 15px;-    padding-right: 15px;-}---/********************************************************************-*  LEFT - EXTRA SUGGESTIONS-*/--#left {-    float: left;-    width: 140px;-    margin: 0px;-    padding: 0px;-    margin-left: 10px;-}--#left li {-    list-style-type: none;-    margin-bottom: 7px;-    white-space: nowrap;-    display: block;-}--#left a {-    color: #C4451D;-    text-decoration: none;-    background-repeat: no-repeat;-}--#left .plus {-    padding-right: 16px;-    background-image: url(more_small.png);-    background-position: center right;-    color: #0E774A;-}--#left .pad {-    padding-left: 16px;-}--#left .minus {-    color: #770E00;-    padding-left: 16px;-    background-image: url(less_small.png);-    background-position: center left;-}---/********************************************************************-*  BOTTOM - COPYRIGHT MESSAGE-*/--#footer {-    background: none repeat scroll 0 0 #DDDDDD;-    border-top: 1px solid #AAAAAA;-    color: #666666;-    width: 100%;-    padding: 1.3em 0;-    position: absolute;-    bottom: 0;-    text-align: center;-}---/********************************************************************-*  HEADING-*/--h1 {-    padding: 5px;-    margin-top: 0px;-    margin-bottom: 0px;-    padding-bottom: 0px;-    font-weight: normal;-    padding-left: 170px;-    font-size: 16px;-}--p {-    margin-left: 170px;-    margin-right: 20px;-    font-size: 16px;-}---/********************************************************************-*  SPECIAL PAGES-*/--.error {-    border-bottom: 2px solid red;-    text-decoration: none;-    white-space: pre;-}--#example {-    margin: auto;-    margin-top: 20px;-    margin-bottom: 20px;-    padding: 3px;-    width: 400px;-    border: 2px solid #cc0;-    background-color: #F5F5F5;-    border: 1px solid #E5E5E5;-    text-align: left;-}--#example a {-    margin-left: 20px;-}---/********************************************************************-*  RESULTS-*/--.result {-    margin-left: 170px;-    margin-right: 20px;-    margin-top: 1.5em;-}--.result.active {-    background-color: #f7f5c0;-}--.from, .doc {-    margin-top: 0.4em;-}--a.dull, a.dull:hover {-    text-decoration: none;-}--/** ANSWERS **/--.ans i {-    font-weight: bold;-    font-style: normal;-}--.ans {-    background: none repeat scroll 0 0 #F0F0F0;-    border-top: 1px solid #CCCCCC;-    font-size: 16px;-    padding: 0.2em 0.5em;-}--.ans .a {-    color: #C4451D;-}--.ans a.dull {-    color: black;-}--.c0{background-color: #fcc;}-.c1{background-color: #cfc;}-.c2{background-color: #ccf;}-.c3{background-color: #ffc;}-.c4{background-color: #fcf;}-.c5{background-color: #cff;}--.more, .more:visited {-    padding-left: 16px;-    background-image: url(more_blue.png);-    background-repeat: no-repeat;-    background-position: center left;-    color: blue;-}--/** PARENTS **/--.p1, .p2 {-    white-space: nowrap;-    text-decoration: none;-    color: #0E774A;-}--/** DOCS **/-/*-docs may be in one of three states:-    .doc - shut and no icon-    .doc.shut - shut with an icon to expand-    .doc.open - open with an icon to collapse-*/--.doc {-    font-size: 11px;-    background-repeat: no-repeat;-    background-position: 2px left;-}-.doc, .doc a {-    color: #888;-}--.open, .shut {padding-left: 13px;}-.open {background-image: url(less_gray.png);}-.shut {background-image: url(more_gray.png);}--.doc, .shut {-    max-height: 1.5em;-    overflow: hidden;-}-.open {-    max-height: 100%;-    white-space: pre-wrap;-}---/********************************************************************-*  PHONE SPECIFIC-*/--.phone #links {-    float: none;-    margin-left: 5px;-}--.phone #search {-    text-align: center;-}--.phone #submit {-    display: none;-}--.phone #left {-    display: none;-}--.phone h1 {-    padding-left: 5px;-}--.phone p {-    margin-left: 5px-}--.phone #example {-    width: auto;-}--.phone #footer {-    font-size: small;-}--.phone .ans, .phone .doc, .phone .from {-    margin-left: 5px;-    margin-right: 5px;-}
− datadir/resources/hoogle.js 
@@ -1,428 +0,0 @@-var embed = false; // are we running as an embedded search box-var instant = false; // should we search on key presses-var query = parseQuery(); // what is the current query string--var $hoogle; // $("#hoogle") after load---/////////////////////////////////////////////////////////////////////-// SEARCHING--$(function(){-    $hoogle = $("#hoogle");-    embed = !$hoogle.hasClass("HOOGLE_REAL");-    var self = embed ? newEmbed() : newReal();-    var $form = $hoogle.parents("form:first");--    var ajaxUrl = !embed ? "?" : $form.attr("action") + "?";-    var ajaxMode = embed ? 'embed' : 'ajax';-    var ajaxPrefix = $form.find("input[name=prefix]").attr("value");-    var ajaxSuffix = $form.find("input[name=suffix]").attr("value");--    var active = $hoogle.val(); // What is currently being searched for (may not yet be displayed)-    var past = cache(100); // Cache of previous searches-    var watch = watchdog(500, function(){self.showWaiting();}); // Timeout of the "Waiting..." callback--    $hoogle.keyup(function(){-        if (!instant) return;--        var now = $hoogle.val();-        if (now == active) return;-        active = now;--        var title = now + (now == "" ? "" : " - ") + "Hoogle";-        query["hoogle"] = now;-        if (!embed){-            if (window.history)-                window.history.replaceState(null, title, renderQuery(query));-            $("title").text(title);-        }--        var old = past.ask(now);-        if (old != undefined){self.showResult(old); return;}--        watch.stop();-        if (embed && now == ""){self.hide(); return;}-        watch.start();--        var data = {hoogle:now, mode:ajaxMode, prefix:ajaxPrefix, suffix:ajaxSuffix};-        function complete(e)-        {-            watch.stop();-            if (e.status == 200)-            {-                past.add(now,e.responseText);-                if ($hoogle.val() == now)-                    self.showResult(e.responseText);-            }-            else-                self.showError(e.status, e.responseText);-        }--        var args = {url:ajaxUrl, data:data, complete:complete, dataType:"html"}-        try {-            $.ajax(args);-        } catch (err) {-            try {-                if (!embed) throw err;-                $.ajaxCrossDomain(args);-            } catch (err) {-                // Probably a permissions error from cross domain scripting...-                watch.stop();-            }-        }-    });-})--function newReal()-{-    $hoogle.focus();-    $hoogle.select();-    var $body = $("#body");--    return {-        showWaiting: function(){$("h1").text("Still working...");},-        showError: function(status,text){$body.html("<h1><b>Error:</b> status " + status + "</h1><p>" + text + "</p>")},-        showResult: function(text){$body.html(text); newDocs();}-    }-}--function newEmbed()-{-    $hoogle.attr("autocomplete","off");-    // IE note: unless the div in the iframe contain any border it doesn't calculate the correct outerHeight()-    //          therefore we put 3 borders on the iframe, and leave one for the bottom div-    var $iframe = $("<iframe id='hoogle-output' scrolling='no' "+-                    "style='position:absolute;border:1px solid rgb(127,157,185);border-bottom:0px;display:none;' />");-    var $body;-    $iframe.load(function(){-        var $contents = $iframe.contents();-        $contents.find("head").html(-            "<style type='text/css'>" +-            "html {border: 0px;}" +-            "body {font-family: sans-serif; font-size: 13px; background-color: white; padding: 0px; margin: 0px;}" +-            "a, i {display: block; color: black; padding: 1px 3px; text-decoration: none; white-space: nowrap; overflow: hidden; cursor: default;}" +-            "a.sel {background-color: rgb(10,36,106); color: white;}" +-            "div {border-bottom:1px solid rgb(127,157,185);}" +-            "</style>");-        $body = $("<div>").appendTo($contents.find("body"));-    });-    $iframe.insertBefore($hoogle);--    var finishOnBlur = true; // Should a blur hide the box--    function show(x){-        if (x == undefined)-            $iframe.css("display","none");-        else {-            $body.html(x).find("a").attr("target","_parent")-                .mousedown(function(){finishOnBlur = false;})-                .mouseup(function(){finishOnBlur = true;})-                .mouseenter(function(){-                    $body.find(".sel").removeClass("sel");-                    $(this).addClass("sel");-                });--            var pos = $hoogle.position();-            // need to display before using $body.outerHeight() on Firefox-            $iframe.css("display","").css(-                {top:px(pos.top + $hoogle.outerHeight() + unpx($hoogle.css("margin-top")))-                ,left:px(pos.left + unpx($hoogle.css("margin-left")))-                ,width:px($hoogle.outerWidth() - 2 /* iframe border */)-                ,height:$body.outerHeight()-                });-        }-    }--    $hoogle.blur(function(){if (finishOnBlur) show();});--    $hoogle.keydown(function(event){-        switch(event.which)-        {-        case Key.Return:-            var sel = $body.find(".sel:first");-            if (sel.size() == 0) return;-            event.preventDefault();-            document.location.href = sel.attr("href");-            break;--        case Key.Escape:-            $body.find(".sel").removeClass("sel");-            show();-            break;--        case Key.Down: case Key.Up:-            var i = event.which == Key.Down ? 1 : -1;-            var all = $body.find("a");-            var sel = all.filter(".sel");-            var now = all.index(sel);-            if (now == -1)-                all.filter(i == 1 ? ":first" : ":last").addClass("sel");-            else {-                sel.removeClass("sel");-                // IE treats :eq(-1) as :eq(0), so filter specifically-                if (now+i >= 0) all.filter(":eq(" + (now+i) + ")").addClass("sel");-            }-            event.preventDefault();-            break;-        }-    });--    return {-        showWaiting: function(){show("<i>Still working...</i>");},-        showError: function(status,text){show("<i>Error: status " + status + "</i>");},-        showResult: function(text){show(text);},-        hide: function(){show();}-    }-}---/////////////////////////////////////////////////////////////////////-// INSTANT BUTTON--$(function(){-    if (embed)-        instant = true;-    else-    {-        setInstant(query["ajax"] == "1" || $.cookie("instant") == "1");-        $("#instant").css("display","");-    }-});--function setInstant(x)-{-    instant = x == undefined ? !instant : x ? true : false;-    $("#instantVal").html(instant ? "on" : "off");-    if (instant)-    {-        $.cookie("instant","1",{expires:365});-        $hoogle.keyup();-    }-    else-        $.cookie("instant",null);-}---/////////////////////////////////////////////////////////////////////-// SEARCH PLUGIN--var prefixUrl = document.location.protocol + "//" + document.location.hostname + document.location.pathname;--$(function(){-    if (embed) return;-    if (prefixUrl != "http://haskell.org/hoogle/")-    {-        $("link[rel=search]").attr("href", function(){-            return this.href + "?domain=" + escape(prefixUrl);-        });-    }-    if (window.external && ("AddSearchProvider" in window.external))-        $("#plugin").css("display","");-});--function searchPlugin()-{-    var url = $("link[rel=search]").attr("href");-    if (url.substring(0, prefixUrl.length) != prefixUrl)-        url = prefixUrl + url;-    window.external.AddSearchProvider(url);-}---/////////////////////////////////////////////////////////////////////-// DOCUMENTATION--$(function(){-    if (embed) return;-    $(window).resize(resizeDocs);-    newDocs();-});--function resizeDocs()-{-    $("#body .doc").each(function(){-        // If a segment is open, it should remain open forever-        var $this = $(this);-        var toosmall = ($.support.preWrap && $this.hasClass("newline")) ||-                       ($this.height() < $this.children().height());-        if (toosmall && !$this.hasClass("open"))-            $this.addClass("shut");-        else if (!toosmall && $this.hasClass("shut"))-            $this.removeClass("shut");-    });-}--function newDocs()-{-    resizeDocs();-    $("#body .doc").click(function(){-        var $this = $(this);-        if ($this.hasClass("open") || $this.hasClass("shut"))-            $this.toggleClass("open").toggleClass("shut");-    });-}---/////////////////////////////////////////////////////////////////////-// iOS TWEAKS--$(function(){-    if ($.support.inputSearch)-        $("#hoogle")[0].type = "search";--    var qphone = query["phone"];-    phone =-        qphone == "0" ? false :-        qphone == "1" ? true :-        $.support.phone;--    if (!phone) return;-    $("body").addClass("phone");-    $("head").append("<meta name='viewport' content='width=device-width' />");-});---/////////////////////////////////////////////////////////////////////-// LIBRARY BITS--function parseQuery() // :: IO (Dict String String)-{-    // From http://stackoverflow.com/questions/901115/get-querystring-values-with-jquery/3867610#3867610-    var params = {},-        e,-        a = /\+/g,  // Regex for replacing addition symbol with a space-        r = /([^&=]+)=?([^&]*)/g,-        d = function (s) { return decodeURIComponent(s.replace(a, " ")); },-        q = window.location.search.substring(1);--    while (e = r.exec(q))-        params[d(e[1])] = d(e[2]);--    return params;-}--function renderQuery(query) // Dict String String -> IO String-{-    var s = "";-    for (var i in query)-    {-        if (query[i] != "")-            s += (s == "" ? "?" : "&") + i + "=" + encodeURIComponent(query[i]);-    }-    return window.location.href.substring(0, window.location.href.length - window.location.search.length) + s;-}---// Supports white-space: pre-wrap;-$.support.preWrap = !($.browser.msie && $.browser.version < 8);--$.support.iOS =-    (navigator.userAgent.indexOf("iPhone") != -1) ||-    (navigator.userAgent.indexOf("iPod") != -1) ||-    (navigator.userAgent.indexOf("iPad") != -1);--$.support.phone =-    (navigator.userAgent.indexOf("iPhone") != -1) ||-    (navigator.userAgent.indexOf("iPod") != -1) ||-    (navigator.userAgent.indexOf("Android") != -1);--// Supports <input type=search />-$.support.inputSearch = $.support.iOS;--var Key = {-    Up: 38,-    Down: 40,-    Return: 13,-    Escape: 27-};--function unpx(x){var r = 1 * x.replace("px",""); return isNaN(r) ? 0 : r;}-function px(x){return x + "px";}--function cache(maxElems)-{-    // FIXME: Currently does not evict things-    var contents = {}; // what we have in the cache, with # prepended-    // note that contents[toString] != undefined, since it's a default method-    // hence the leading #--    return {-        add: function(key,val)-        {-            contents["#" + key] = val;-        },--        ask: function(key)-        {-            return contents["#" + key];-        }-    };-}--function watchdog(time, fun)-{-    var id = undefined;-    function stop(){if (id == undefined) return; window.clearTimeout(id); id = undefined;}-    function start(){stop(); id = window.setTimeout(function(){id = undefined; fun();}, time);}-    return {start:start, stop:stop}-}--$.ajaxCrossDomain = function(args)-{-    if (!window.XDomainRequest) throw new Error("the XDomainRequest object is not supported in this browser");--    var xdr = new XDomainRequest();-    xdr.onload = function(){args.complete({status:200, responseText:xdr.responseText});};-    xdr.onerror = function(){args.complete({status:0, responseText:""});};--    var url = "";-    for (var i in args.data)-    {-        if (args.data[i] == undefined) continue;-        url += (url == "" ? "" : "&") + encodeURIComponent(i) + "=" + encodeURIComponent(args.data[i]);-    }-    xdr.open("get", args.url + url);-    xdr.send();-}--function on_arrow_press(ev) {-    var offset = 0;-    if (ev.keyCode == Key.Up) {-        offset = -1;-    } else if (ev.keyCode == Key.Down) {-        offset = +1;-    } else if (ev.keyCode != Key.Return) {-        return;-    }--    // Figure out where we are-    var results = $("div#body .result");-    var activeResults = $("div#body .result.active");-    var activeRow = -1;-    if (activeResults.length == 1) {-        activeRow = results.index(activeResults[0]);-    }--    if (ev.keyCode == Key.Return) {-        if (activeRow >= 0)-            document.location.href = $("a", activeResults).attr("href");-    } else {-        var newRow = activeRow + offset;-        var $activeRow = $(results[activeRow]);-        if (newRow < 0) {-            $activeRow.removeClass("active");-            $hoogle.focus();-        } else if (newRow < results.length) {-            var $newRow = $(results[newRow]);-            if (activeRow >= 0)-                $activeRow.removeClass("active");-            $newRow.addClass("active");-            $hoogle.blur();-        }-    }-}--$(document).ready(function() {-    $(document).keyup(on_arrow_press);-});
− datadir/resources/hoogle.png

binary file changed (3079 → absent bytes)

− datadir/resources/jquery-cookie.js 
@@ -1,96 +0,0 @@-/**- * Cookie plugin- *- * Copyright (c) 2006 Klaus Hartl (stilbuero.de)- * Dual licensed under the MIT and GPL licenses:- * http://www.opensource.org/licenses/mit-license.php- * http://www.gnu.org/licenses/gpl.html- *- */--/**- * Create a cookie with the given name and value and other optional parameters.- *- * @example $.cookie('the_cookie', 'the_value');- * @desc Set the value of a cookie.- * @example $.cookie('the_cookie', 'the_value', { expires: 7, path: '/', domain: 'jquery.com', secure: true });- * @desc Create a cookie with all available options.- * @example $.cookie('the_cookie', 'the_value');- * @desc Create a session cookie.- * @example $.cookie('the_cookie', null);- * @desc Delete a cookie by passing null as value. Keep in mind that you have to use the same path and domain- *       used when the cookie was set.- *- * @param String name The name of the cookie.- * @param String value The value of the cookie.- * @param Object options An object literal containing key/value pairs to provide optional cookie attributes.- * @option Number|Date expires Either an integer specifying the expiration date from now on in days or a Date object.- *                             If a negative value is specified (e.g. a date in the past), the cookie will be deleted.- *                             If set to null or omitted, the cookie will be a session cookie and will not be retained- *                             when the the browser exits.- * @option String path The value of the path atribute of the cookie (default: path of page that created the cookie).- * @option String domain The value of the domain attribute of the cookie (default: domain of page that created the cookie).- * @option Boolean secure If true, the secure attribute of the cookie will be set and the cookie transmission will- *                        require a secure protocol (like HTTPS).- * @type undefined- *- * @name $.cookie- * @cat Plugins/Cookie- * @author Klaus Hartl/klaus.hartl@stilbuero.de- */--/**- * Get the value of a cookie with the given name.- *- * @example $.cookie('the_cookie');- * @desc Get the value of a cookie.- *- * @param String name The name of the cookie.- * @return The value of the cookie.- * @type String- *- * @name $.cookie- * @cat Plugins/Cookie- * @author Klaus Hartl/klaus.hartl@stilbuero.de- */-jQuery.cookie = function(name, value, options) {-    if (typeof value != 'undefined') { // name and value given, set cookie-        options = options || {};-        if (value === null) {-            value = '';-            options.expires = -1;-        }-        var expires = '';-        if (options.expires && (typeof options.expires == 'number' || options.expires.toUTCString)) {-            var date;-            if (typeof options.expires == 'number') {-                date = new Date();-                date.setTime(date.getTime() + (options.expires * 24 * 60 * 60 * 1000));-            } else {-                date = options.expires;-            }-            expires = '; expires=' + date.toUTCString(); // use expires attribute, max-age is not supported by IE-        }-        // CAUTION: Needed to parenthesize options.path and options.domain-        // in the following expressions, otherwise they evaluate to undefined-        // in the packed version for some reason...-        var path = options.path ? '; path=' + (options.path) : '';-        var domain = options.domain ? '; domain=' + (options.domain) : '';-        var secure = options.secure ? '; secure' : '';-        document.cookie = [name, '=', encodeURIComponent(value), expires, path, domain, secure].join('');-    } else { // only name given, get cookie-        var cookieValue = null;-        if (document.cookie && document.cookie != '') {-            var cookies = document.cookie.split(';');-            for (var i = 0; i < cookies.length; i++) {-                var cookie = jQuery.trim(cookies[i]);-                // Does this cookie string begin with the name we want?-                if (cookie.substring(0, name.length + 1) == (name + '=')) {-                    cookieValue = decodeURIComponent(cookie.substring(name.length + 1));-                    break;-                }-            }-        }-        return cookieValue;-    }-};
− datadir/resources/jquery.js 
@@ -1,4 +0,0 @@-/*! jQuery v1.7.2 jquery.com | jquery.org/license */-(function(a,b){function cy(a){return f.isWindow(a)?a:a.nodeType===9?a.defaultView||a.parentWindow:!1}function cu(a){if(!cj[a]){var b=c.body,d=f("<"+a+">").appendTo(b),e=d.css("display");d.remove();if(e==="none"||e===""){ck||(ck=c.createElement("iframe"),ck.frameBorder=ck.width=ck.height=0),b.appendChild(ck);if(!cl||!ck.createElement)cl=(ck.contentWindow||ck.contentDocument).document,cl.write((f.support.boxModel?"<!doctype html>":"")+"<html><body>"),cl.close();d=cl.createElement(a),cl.body.appendChild(d),e=f.css(d,"display"),b.removeChild(ck)}cj[a]=e}return cj[a]}function ct(a,b){var c={};f.each(cp.concat.apply([],cp.slice(0,b)),function(){c[this]=a});return c}function cs(){cq=b}function cr(){setTimeout(cs,0);return cq=f.now()}function ci(){try{return new a.ActiveXObject("Microsoft.XMLHTTP")}catch(b){}}function ch(){try{return new a.XMLHttpRequest}catch(b){}}function cb(a,c){a.dataFilter&&(c=a.dataFilter(c,a.dataType));var d=a.dataTypes,e={},g,h,i=d.length,j,k=d[0],l,m,n,o,p;for(g=1;g<i;g++){if(g===1)for(h in a.converters)typeof h=="string"&&(e[h.toLowerCase()]=a.converters[h]);l=k,k=d[g];if(k==="*")k=l;else if(l!=="*"&&l!==k){m=l+" "+k,n=e[m]||e["* "+k];if(!n){p=b;for(o in e){j=o.split(" ");if(j[0]===l||j[0]==="*"){p=e[j[1]+" "+k];if(p){o=e[o],o===!0?n=p:p===!0&&(n=o);break}}}}!n&&!p&&f.error("No conversion from "+m.replace(" "," to ")),n!==!0&&(c=n?n(c):p(o(c)))}}return c}function ca(a,c,d){var e=a.contents,f=a.dataTypes,g=a.responseFields,h,i,j,k;for(i in g)i in d&&(c[g[i]]=d[i]);while(f[0]==="*")f.shift(),h===b&&(h=a.mimeType||c.getResponseHeader("content-type"));if(h)for(i in e)if(e[i]&&e[i].test(h)){f.unshift(i);break}if(f[0]in d)j=f[0];else{for(i in d){if(!f[0]||a.converters[i+" "+f[0]]){j=i;break}k||(k=i)}j=j||k}if(j){j!==f[0]&&f.unshift(j);return d[j]}}function b_(a,b,c,d){if(f.isArray(b))f.each(b,function(b,e){c||bD.test(a)?d(a,e):b_(a+"["+(typeof e=="object"?b:"")+"]",e,c,d)});else if(!c&&f.type(b)==="object")for(var e in b)b_(a+"["+e+"]",b[e],c,d);else d(a,b)}function b$(a,c){var d,e,g=f.ajaxSettings.flatOptions||{};for(d in c)c[d]!==b&&((g[d]?a:e||(e={}))[d]=c[d]);e&&f.extend(!0,a,e)}function bZ(a,c,d,e,f,g){f=f||c.dataTypes[0],g=g||{},g[f]=!0;var h=a[f],i=0,j=h?h.length:0,k=a===bS,l;for(;i<j&&(k||!l);i++)l=h[i](c,d,e),typeof l=="string"&&(!k||g[l]?l=b:(c.dataTypes.unshift(l),l=bZ(a,c,d,e,l,g)));(k||!l)&&!g["*"]&&(l=bZ(a,c,d,e,"*",g));return l}function bY(a){return function(b,c){typeof b!="string"&&(c=b,b="*");if(f.isFunction(c)){var d=b.toLowerCase().split(bO),e=0,g=d.length,h,i,j;for(;e<g;e++)h=d[e],j=/^\+/.test(h),j&&(h=h.substr(1)||"*"),i=a[h]=a[h]||[],i[j?"unshift":"push"](c)}}}function bB(a,b,c){var d=b==="width"?a.offsetWidth:a.offsetHeight,e=b==="width"?1:0,g=4;if(d>0){if(c!=="border")for(;e<g;e+=2)c||(d-=parseFloat(f.css(a,"padding"+bx[e]))||0),c==="margin"?d+=parseFloat(f.css(a,c+bx[e]))||0:d-=parseFloat(f.css(a,"border"+bx[e]+"Width"))||0;return d+"px"}d=by(a,b);if(d<0||d==null)d=a.style[b];if(bt.test(d))return d;d=parseFloat(d)||0;if(c)for(;e<g;e+=2)d+=parseFloat(f.css(a,"padding"+bx[e]))||0,c!=="padding"&&(d+=parseFloat(f.css(a,"border"+bx[e]+"Width"))||0),c==="margin"&&(d+=parseFloat(f.css(a,c+bx[e]))||0);return d+"px"}function bo(a){var b=c.createElement("div");bh.appendChild(b),b.innerHTML=a.outerHTML;return b.firstChild}function bn(a){var b=(a.nodeName||"").toLowerCase();b==="input"?bm(a):b!=="script"&&typeof a.getElementsByTagName!="undefined"&&f.grep(a.getElementsByTagName("input"),bm)}function bm(a){if(a.type==="checkbox"||a.type==="radio")a.defaultChecked=a.checked}function bl(a){return typeof a.getElementsByTagName!="undefined"?a.getElementsByTagName("*"):typeof a.querySelectorAll!="undefined"?a.querySelectorAll("*"):[]}function bk(a,b){var c;b.nodeType===1&&(b.clearAttributes&&b.clearAttributes(),b.mergeAttributes&&b.mergeAttributes(a),c=b.nodeName.toLowerCase(),c==="object"?b.outerHTML=a.outerHTML:c!=="input"||a.type!=="checkbox"&&a.type!=="radio"?c==="option"?b.selected=a.defaultSelected:c==="input"||c==="textarea"?b.defaultValue=a.defaultValue:c==="script"&&b.text!==a.text&&(b.text=a.text):(a.checked&&(b.defaultChecked=b.checked=a.checked),b.value!==a.value&&(b.value=a.value)),b.removeAttribute(f.expando),b.removeAttribute("_submit_attached"),b.removeAttribute("_change_attached"))}function bj(a,b){if(b.nodeType===1&&!!f.hasData(a)){var c,d,e,g=f._data(a),h=f._data(b,g),i=g.events;if(i){delete h.handle,h.events={};for(c in i)for(d=0,e=i[c].length;d<e;d++)f.event.add(b,c,i[c][d])}h.data&&(h.data=f.extend({},h.data))}}function bi(a,b){return f.nodeName(a,"table")?a.getElementsByTagName("tbody")[0]||a.appendChild(a.ownerDocument.createElement("tbody")):a}function U(a){var b=V.split("|"),c=a.createDocumentFragment();if(c.createElement)while(b.length)c.createElement(b.pop());return c}function T(a,b,c){b=b||0;if(f.isFunction(b))return f.grep(a,function(a,d){var e=!!b.call(a,d,a);return e===c});if(b.nodeType)return f.grep(a,function(a,d){return a===b===c});if(typeof b=="string"){var d=f.grep(a,function(a){return a.nodeType===1});if(O.test(b))return f.filter(b,d,!c);b=f.filter(b,d)}return f.grep(a,function(a,d){return f.inArray(a,b)>=0===c})}function S(a){return!a||!a.parentNode||a.parentNode.nodeType===11}function K(){return!0}function J(){return!1}function n(a,b,c){var d=b+"defer",e=b+"queue",g=b+"mark",h=f._data(a,d);h&&(c==="queue"||!f._data(a,e))&&(c==="mark"||!f._data(a,g))&&setTimeout(function(){!f._data(a,e)&&!f._data(a,g)&&(f.removeData(a,d,!0),h.fire())},0)}function m(a){for(var b in a){if(b==="data"&&f.isEmptyObject(a[b]))continue;if(b!=="toJSON")return!1}return!0}function l(a,c,d){if(d===b&&a.nodeType===1){var e="data-"+c.replace(k,"-$1").toLowerCase();d=a.getAttribute(e);if(typeof d=="string"){try{d=d==="true"?!0:d==="false"?!1:d==="null"?null:f.isNumeric(d)?+d:j.test(d)?f.parseJSON(d):d}catch(g){}f.data(a,c,d)}else d=b}return d}function h(a){var b=g[a]={},c,d;a=a.split(/\s+/);for(c=0,d=a.length;c<d;c++)b[a[c]]=!0;return b}var c=a.document,d=a.navigator,e=a.location,f=function(){function J(){if(!e.isReady){try{c.documentElement.doScroll("left")}catch(a){setTimeout(J,1);return}e.ready()}}var e=function(a,b){return new e.fn.init(a,b,h)},f=a.jQuery,g=a.$,h,i=/^(?:[^#<]*(<[\w\W]+>)[^>]*$|#([\w\-]*)$)/,j=/\S/,k=/^\s+/,l=/\s+$/,m=/^<(\w+)\s*\/?>(?:<\/\1>)?$/,n=/^[\],:{}\s]*$/,o=/\\(?:["\\\/bfnrt]|u[0-9a-fA-F]{4})/g,p=/"[^"\\\n\r]*"|true|false|null|-?\d+(?:\.\d*)?(?:[eE][+\-]?\d+)?/g,q=/(?:^|:|,)(?:\s*\[)+/g,r=/(webkit)[ \/]([\w.]+)/,s=/(opera)(?:.*version)?[ \/]([\w.]+)/,t=/(msie) ([\w.]+)/,u=/(mozilla)(?:.*? rv:([\w.]+))?/,v=/-([a-z]|[0-9])/ig,w=/^-ms-/,x=function(a,b){return(b+"").toUpperCase()},y=d.userAgent,z,A,B,C=Object.prototype.toString,D=Object.prototype.hasOwnProperty,E=Array.prototype.push,F=Array.prototype.slice,G=String.prototype.trim,H=Array.prototype.indexOf,I={};e.fn=e.prototype={constructor:e,init:function(a,d,f){var g,h,j,k;if(!a)return this;if(a.nodeType){this.context=this[0]=a,this.length=1;return this}if(a==="body"&&!d&&c.body){this.context=c,this[0]=c.body,this.selector=a,this.length=1;return this}if(typeof a=="string"){a.charAt(0)!=="<"||a.charAt(a.length-1)!==">"||a.length<3?g=i.exec(a):g=[null,a,null];if(g&&(g[1]||!d)){if(g[1]){d=d instanceof e?d[0]:d,k=d?d.ownerDocument||d:c,j=m.exec(a),j?e.isPlainObject(d)?(a=[c.createElement(j[1])],e.fn.attr.call(a,d,!0)):a=[k.createElement(j[1])]:(j=e.buildFragment([g[1]],[k]),a=(j.cacheable?e.clone(j.fragment):j.fragment).childNodes);return e.merge(this,a)}h=c.getElementById(g[2]);if(h&&h.parentNode){if(h.id!==g[2])return f.find(a);this.length=1,this[0]=h}this.context=c,this.selector=a;return this}return!d||d.jquery?(d||f).find(a):this.constructor(d).find(a)}if(e.isFunction(a))return f.ready(a);a.selector!==b&&(this.selector=a.selector,this.context=a.context);return e.makeArray(a,this)},selector:"",jquery:"1.7.2",length:0,size:function(){return this.length},toArray:function(){return F.call(this,0)},get:function(a){return a==null?this.toArray():a<0?this[this.length+a]:this[a]},pushStack:function(a,b,c){var d=this.constructor();e.isArray(a)?E.apply(d,a):e.merge(d,a),d.prevObject=this,d.context=this.context,b==="find"?d.selector=this.selector+(this.selector?" ":"")+c:b&&(d.selector=this.selector+"."+b+"("+c+")");return d},each:function(a,b){return e.each(this,a,b)},ready:function(a){e.bindReady(),A.add(a);return this},eq:function(a){a=+a;return a===-1?this.slice(a):this.slice(a,a+1)},first:function(){return this.eq(0)},last:function(){return this.eq(-1)},slice:function(){return this.pushStack(F.apply(this,arguments),"slice",F.call(arguments).join(","))},map:function(a){return this.pushStack(e.map(this,function(b,c){return a.call(b,c,b)}))},end:function(){return this.prevObject||this.constructor(null)},push:E,sort:[].sort,splice:[].splice},e.fn.init.prototype=e.fn,e.extend=e.fn.extend=function(){var a,c,d,f,g,h,i=arguments[0]||{},j=1,k=arguments.length,l=!1;typeof i=="boolean"&&(l=i,i=arguments[1]||{},j=2),typeof i!="object"&&!e.isFunction(i)&&(i={}),k===j&&(i=this,--j);for(;j<k;j++)if((a=arguments[j])!=null)for(c in a){d=i[c],f=a[c];if(i===f)continue;l&&f&&(e.isPlainObject(f)||(g=e.isArray(f)))?(g?(g=!1,h=d&&e.isArray(d)?d:[]):h=d&&e.isPlainObject(d)?d:{},i[c]=e.extend(l,h,f)):f!==b&&(i[c]=f)}return i},e.extend({noConflict:function(b){a.$===e&&(a.$=g),b&&a.jQuery===e&&(a.jQuery=f);return e},isReady:!1,readyWait:1,holdReady:function(a){a?e.readyWait++:e.ready(!0)},ready:function(a){if(a===!0&&!--e.readyWait||a!==!0&&!e.isReady){if(!c.body)return setTimeout(e.ready,1);e.isReady=!0;if(a!==!0&&--e.readyWait>0)return;A.fireWith(c,[e]),e.fn.trigger&&e(c).trigger("ready").off("ready")}},bindReady:function(){if(!A){A=e.Callbacks("once memory");if(c.readyState==="complete")return setTimeout(e.ready,1);if(c.addEventListener)c.addEventListener("DOMContentLoaded",B,!1),a.addEventListener("load",e.ready,!1);else if(c.attachEvent){c.attachEvent("onreadystatechange",B),a.attachEvent("onload",e.ready);var b=!1;try{b=a.frameElement==null}catch(d){}c.documentElement.doScroll&&b&&J()}}},isFunction:function(a){return e.type(a)==="function"},isArray:Array.isArray||function(a){return e.type(a)==="array"},isWindow:function(a){return a!=null&&a==a.window},isNumeric:function(a){return!isNaN(parseFloat(a))&&isFinite(a)},type:function(a){return a==null?String(a):I[C.call(a)]||"object"},isPlainObject:function(a){if(!a||e.type(a)!=="object"||a.nodeType||e.isWindow(a))return!1;try{if(a.constructor&&!D.call(a,"constructor")&&!D.call(a.constructor.prototype,"isPrototypeOf"))return!1}catch(c){return!1}var d;for(d in a);return d===b||D.call(a,d)},isEmptyObject:function(a){for(var b in a)return!1;return!0},error:function(a){throw new Error(a)},parseJSON:function(b){if(typeof b!="string"||!b)return null;b=e.trim(b);if(a.JSON&&a.JSON.parse)return a.JSON.parse(b);if(n.test(b.replace(o,"@").replace(p,"]").replace(q,"")))return(new Function("return "+b))();e.error("Invalid JSON: "+b)},parseXML:function(c){if(typeof c!="string"||!c)return null;var d,f;try{a.DOMParser?(f=new DOMParser,d=f.parseFromString(c,"text/xml")):(d=new ActiveXObject("Microsoft.XMLDOM"),d.async="false",d.loadXML(c))}catch(g){d=b}(!d||!d.documentElement||d.getElementsByTagName("parsererror").length)&&e.error("Invalid XML: "+c);return d},noop:function(){},globalEval:function(b){b&&j.test(b)&&(a.execScript||function(b){a.eval.call(a,b)})(b)},camelCase:function(a){return a.replace(w,"ms-").replace(v,x)},nodeName:function(a,b){return a.nodeName&&a.nodeName.toUpperCase()===b.toUpperCase()},each:function(a,c,d){var f,g=0,h=a.length,i=h===b||e.isFunction(a);if(d){if(i){for(f in a)if(c.apply(a[f],d)===!1)break}else for(;g<h;)if(c.apply(a[g++],d)===!1)break}else if(i){for(f in a)if(c.call(a[f],f,a[f])===!1)break}else for(;g<h;)if(c.call(a[g],g,a[g++])===!1)break;return a},trim:G?function(a){return a==null?"":G.call(a)}:function(a){return a==null?"":(a+"").replace(k,"").replace(l,"")},makeArray:function(a,b){var c=b||[];if(a!=null){var d=e.type(a);a.length==null||d==="string"||d==="function"||d==="regexp"||e.isWindow(a)?E.call(c,a):e.merge(c,a)}return c},inArray:function(a,b,c){var d;if(b){if(H)return H.call(b,a,c);d=b.length,c=c?c<0?Math.max(0,d+c):c:0;for(;c<d;c++)if(c in b&&b[c]===a)return c}return-1},merge:function(a,c){var d=a.length,e=0;if(typeof c.length=="number")for(var f=c.length;e<f;e++)a[d++]=c[e];else while(c[e]!==b)a[d++]=c[e++];a.length=d;return a},grep:function(a,b,c){var d=[],e;c=!!c;for(var f=0,g=a.length;f<g;f++)e=!!b(a[f],f),c!==e&&d.push(a[f]);return d},map:function(a,c,d){var f,g,h=[],i=0,j=a.length,k=a instanceof e||j!==b&&typeof j=="number"&&(j>0&&a[0]&&a[j-1]||j===0||e.isArray(a));if(k)for(;i<j;i++)f=c(a[i],i,d),f!=null&&(h[h.length]=f);else for(g in a)f=c(a[g],g,d),f!=null&&(h[h.length]=f);return h.concat.apply([],h)},guid:1,proxy:function(a,c){if(typeof c=="string"){var d=a[c];c=a,a=d}if(!e.isFunction(a))return b;var f=F.call(arguments,2),g=function(){return a.apply(c,f.concat(F.call(arguments)))};g.guid=a.guid=a.guid||g.guid||e.guid++;return g},access:function(a,c,d,f,g,h,i){var j,k=d==null,l=0,m=a.length;if(d&&typeof d=="object"){for(l in d)e.access(a,c,l,d[l],1,h,f);g=1}else if(f!==b){j=i===b&&e.isFunction(f),k&&(j?(j=c,c=function(a,b,c){return j.call(e(a),c)}):(c.call(a,f),c=null));if(c)for(;l<m;l++)c(a[l],d,j?f.call(a[l],l,c(a[l],d)):f,i);g=1}return g?a:k?c.call(a):m?c(a[0],d):h},now:function(){return(new Date).getTime()},uaMatch:function(a){a=a.toLowerCase();var b=r.exec(a)||s.exec(a)||t.exec(a)||a.indexOf("compatible")<0&&u.exec(a)||[];return{browser:b[1]||"",version:b[2]||"0"}},sub:function(){function a(b,c){return new a.fn.init(b,c)}e.extend(!0,a,this),a.superclass=this,a.fn=a.prototype=this(),a.fn.constructor=a,a.sub=this.sub,a.fn.init=function(d,f){f&&f instanceof e&&!(f instanceof a)&&(f=a(f));return e.fn.init.call(this,d,f,b)},a.fn.init.prototype=a.fn;var b=a(c);return a},browser:{}}),e.each("Boolean Number String Function Array Date RegExp Object".split(" "),function(a,b){I["[object "+b+"]"]=b.toLowerCase()}),z=e.uaMatch(y),z.browser&&(e.browser[z.browser]=!0,e.browser.version=z.version),e.browser.webkit&&(e.browser.safari=!0),j.test(" ")&&(k=/^[\s\xA0]+/,l=/[\s\xA0]+$/),h=e(c),c.addEventListener?B=function(){c.removeEventListener("DOMContentLoaded",B,!1),e.ready()}:c.attachEvent&&(B=function(){c.readyState==="complete"&&(c.detachEvent("onreadystatechange",B),e.ready())});return e}(),g={};f.Callbacks=function(a){a=a?g[a]||h(a):{};var c=[],d=[],e,i,j,k,l,m,n=function(b){var d,e,g,h,i;for(d=0,e=b.length;d<e;d++)g=b[d],h=f.type(g),h==="array"?n(g):h==="function"&&(!a.unique||!p.has(g))&&c.push(g)},o=function(b,f){f=f||[],e=!a.memory||[b,f],i=!0,j=!0,m=k||0,k=0,l=c.length;for(;c&&m<l;m++)if(c[m].apply(b,f)===!1&&a.stopOnFalse){e=!0;break}j=!1,c&&(a.once?e===!0?p.disable():c=[]:d&&d.length&&(e=d.shift(),p.fireWith(e[0],e[1])))},p={add:function(){if(c){var a=c.length;n(arguments),j?l=c.length:e&&e!==!0&&(k=a,o(e[0],e[1]))}return this},remove:function(){if(c){var b=arguments,d=0,e=b.length;for(;d<e;d++)for(var f=0;f<c.length;f++)if(b[d]===c[f]){j&&f<=l&&(l--,f<=m&&m--),c.splice(f--,1);if(a.unique)break}}return this},has:function(a){if(c){var b=0,d=c.length;for(;b<d;b++)if(a===c[b])return!0}return!1},empty:function(){c=[];return this},disable:function(){c=d=e=b;return this},disabled:function(){return!c},lock:function(){d=b,(!e||e===!0)&&p.disable();return this},locked:function(){return!d},fireWith:function(b,c){d&&(j?a.once||d.push([b,c]):(!a.once||!e)&&o(b,c));return this},fire:function(){p.fireWith(this,arguments);return this},fired:function(){return!!i}};return p};var i=[].slice;f.extend({Deferred:function(a){var b=f.Callbacks("once memory"),c=f.Callbacks("once memory"),d=f.Callbacks("memory"),e="pending",g={resolve:b,reject:c,notify:d},h={done:b.add,fail:c.add,progress:d.add,state:function(){return e},isResolved:b.fired,isRejected:c.fired,then:function(a,b,c){i.done(a).fail(b).progress(c);return this},always:function(){i.done.apply(i,arguments).fail.apply(i,arguments);return this},pipe:function(a,b,c){return f.Deferred(function(d){f.each({done:[a,"resolve"],fail:[b,"reject"],progress:[c,"notify"]},function(a,b){var c=b[0],e=b[1],g;f.isFunction(c)?i[a](function(){g=c.apply(this,arguments),g&&f.isFunction(g.promise)?g.promise().then(d.resolve,d.reject,d.notify):d[e+"With"](this===i?d:this,[g])}):i[a](d[e])})}).promise()},promise:function(a){if(a==null)a=h;else for(var b in h)a[b]=h[b];return a}},i=h.promise({}),j;for(j in g)i[j]=g[j].fire,i[j+"With"]=g[j].fireWith;i.done(function(){e="resolved"},c.disable,d.lock).fail(function(){e="rejected"},b.disable,d.lock),a&&a.call(i,i);return i},when:function(a){function m(a){return function(b){e[a]=arguments.length>1?i.call(arguments,0):b,j.notifyWith(k,e)}}function l(a){return function(c){b[a]=arguments.length>1?i.call(arguments,0):c,--g||j.resolveWith(j,b)}}var b=i.call(arguments,0),c=0,d=b.length,e=Array(d),g=d,h=d,j=d<=1&&a&&f.isFunction(a.promise)?a:f.Deferred(),k=j.promise();if(d>1){for(;c<d;c++)b[c]&&b[c].promise&&f.isFunction(b[c].promise)?b[c].promise().then(l(c),j.reject,m(c)):--g;g||j.resolveWith(j,b)}else j!==a&&j.resolveWith(j,d?[a]:[]);return k}}),f.support=function(){var b,d,e,g,h,i,j,k,l,m,n,o,p=c.createElement("div"),q=c.documentElement;p.setAttribute("className","t"),p.innerHTML="   <link/><table></table><a href='/a' style='top:1px;float:left;opacity:.55;'>a</a><input type='checkbox'/>",d=p.getElementsByTagName("*"),e=p.getElementsByTagName("a")[0];if(!d||!d.length||!e)return{};g=c.createElement("select"),h=g.appendChild(c.createElement("option")),i=p.getElementsByTagName("input")[0],b={leadingWhitespace:p.firstChild.nodeType===3,tbody:!p.getElementsByTagName("tbody").length,htmlSerialize:!!p.getElementsByTagName("link").length,style:/top/.test(e.getAttribute("style")),hrefNormalized:e.getAttribute("href")==="/a",opacity:/^0.55/.test(e.style.opacity),cssFloat:!!e.style.cssFloat,checkOn:i.value==="on",optSelected:h.selected,getSetAttribute:p.className!=="t",enctype:!!c.createElement("form").enctype,html5Clone:c.createElement("nav").cloneNode(!0).outerHTML!=="<:nav></:nav>",submitBubbles:!0,changeBubbles:!0,focusinBubbles:!1,deleteExpando:!0,noCloneEvent:!0,inlineBlockNeedsLayout:!1,shrinkWrapBlocks:!1,reliableMarginRight:!0,pixelMargin:!0},f.boxModel=b.boxModel=c.compatMode==="CSS1Compat",i.checked=!0,b.noCloneChecked=i.cloneNode(!0).checked,g.disabled=!0,b.optDisabled=!h.disabled;try{delete p.test}catch(r){b.deleteExpando=!1}!p.addEventListener&&p.attachEvent&&p.fireEvent&&(p.attachEvent("onclick",function(){b.noCloneEvent=!1}),p.cloneNode(!0).fireEvent("onclick")),i=c.createElement("input"),i.value="t",i.setAttribute("type","radio"),b.radioValue=i.value==="t",i.setAttribute("checked","checked"),i.setAttribute("name","t"),p.appendChild(i),j=c.createDocumentFragment(),j.appendChild(p.lastChild),b.checkClone=j.cloneNode(!0).cloneNode(!0).lastChild.checked,b.appendChecked=i.checked,j.removeChild(i),j.appendChild(p);if(p.attachEvent)for(n in{submit:1,change:1,focusin:1})m="on"+n,o=m in p,o||(p.setAttribute(m,"return;"),o=typeof p[m]=="function"),b[n+"Bubbles"]=o;j.removeChild(p),j=g=h=p=i=null,f(function(){var d,e,g,h,i,j,l,m,n,q,r,s,t,u=c.getElementsByTagName("body")[0];!u||(m=1,t="padding:0;margin:0;border:",r="position:absolute;top:0;left:0;width:1px;height:1px;",s=t+"0;visibility:hidden;",n="style='"+r+t+"5px solid #000;",q="<div "+n+"display:block;'><div style='"+t+"0;display:block;overflow:hidden;'></div></div>"+"<table "+n+"' cellpadding='0' cellspacing='0'>"+"<tr><td></td></tr></table>",d=c.createElement("div"),d.style.cssText=s+"width:0;height:0;position:static;top:0;margin-top:"+m+"px",u.insertBefore(d,u.firstChild),p=c.createElement("div"),d.appendChild(p),p.innerHTML="<table><tr><td style='"+t+"0;display:none'></td><td>t</td></tr></table>",k=p.getElementsByTagName("td"),o=k[0].offsetHeight===0,k[0].style.display="",k[1].style.display="none",b.reliableHiddenOffsets=o&&k[0].offsetHeight===0,a.getComputedStyle&&(p.innerHTML="",l=c.createElement("div"),l.style.width="0",l.style.marginRight="0",p.style.width="2px",p.appendChild(l),b.reliableMarginRight=(parseInt((a.getComputedStyle(l,null)||{marginRight:0}).marginRight,10)||0)===0),typeof p.style.zoom!="undefined"&&(p.innerHTML="",p.style.width=p.style.padding="1px",p.style.border=0,p.style.overflow="hidden",p.style.display="inline",p.style.zoom=1,b.inlineBlockNeedsLayout=p.offsetWidth===3,p.style.display="block",p.style.overflow="visible",p.innerHTML="<div style='width:5px;'></div>",b.shrinkWrapBlocks=p.offsetWidth!==3),p.style.cssText=r+s,p.innerHTML=q,e=p.firstChild,g=e.firstChild,i=e.nextSibling.firstChild.firstChild,j={doesNotAddBorder:g.offsetTop!==5,doesAddBorderForTableAndCells:i.offsetTop===5},g.style.position="fixed",g.style.top="20px",j.fixedPosition=g.offsetTop===20||g.offsetTop===15,g.style.position=g.style.top="",e.style.overflow="hidden",e.style.position="relative",j.subtractsBorderForOverflowNotVisible=g.offsetTop===-5,j.doesNotIncludeMarginInBodyOffset=u.offsetTop!==m,a.getComputedStyle&&(p.style.marginTop="1%",b.pixelMargin=(a.getComputedStyle(p,null)||{marginTop:0}).marginTop!=="1%"),typeof d.style.zoom!="undefined"&&(d.style.zoom=1),u.removeChild(d),l=p=d=null,f.extend(b,j))});return b}();var j=/^(?:\{.*\}|\[.*\])$/,k=/([A-Z])/g;f.extend({cache:{},uuid:0,expando:"jQuery"+(f.fn.jquery+Math.random()).replace(/\D/g,""),noData:{embed:!0,object:"clsid:D27CDB6E-AE6D-11cf-96B8-444553540000",applet:!0},hasData:function(a){a=a.nodeType?f.cache[a[f.expando]]:a[f.expando];return!!a&&!m(a)},data:function(a,c,d,e){if(!!f.acceptData(a)){var g,h,i,j=f.expando,k=typeof c=="string",l=a.nodeType,m=l?f.cache:a,n=l?a[j]:a[j]&&j,o=c==="events";if((!n||!m[n]||!o&&!e&&!m[n].data)&&k&&d===b)return;n||(l?a[j]=n=++f.uuid:n=j),m[n]||(m[n]={},l||(m[n].toJSON=f.noop));if(typeof c=="object"||typeof c=="function")e?m[n]=f.extend(m[n],c):m[n].data=f.extend(m[n].data,c);g=h=m[n],e||(h.data||(h.data={}),h=h.data),d!==b&&(h[f.camelCase(c)]=d);if(o&&!h[c])return g.events;k?(i=h[c],i==null&&(i=h[f.camelCase(c)])):i=h;return i}},removeData:function(a,b,c){if(!!f.acceptData(a)){var d,e,g,h=f.expando,i=a.nodeType,j=i?f.cache:a,k=i?a[h]:h;if(!j[k])return;if(b){d=c?j[k]:j[k].data;if(d){f.isArray(b)||(b in d?b=[b]:(b=f.camelCase(b),b in d?b=[b]:b=b.split(" ")));for(e=0,g=b.length;e<g;e++)delete d[b[e]];if(!(c?m:f.isEmptyObject)(d))return}}if(!c){delete j[k].data;if(!m(j[k]))return}f.support.deleteExpando||!j.setInterval?delete j[k]:j[k]=null,i&&(f.support.deleteExpando?delete a[h]:a.removeAttribute?a.removeAttribute(h):a[h]=null)}},_data:function(a,b,c){return f.data(a,b,c,!0)},acceptData:function(a){if(a.nodeName){var b=f.noData[a.nodeName.toLowerCase()];if(b)return b!==!0&&a.getAttribute("classid")===b}return!0}}),f.fn.extend({data:function(a,c){var d,e,g,h,i,j=this[0],k=0,m=null;if(a===b){if(this.length){m=f.data(j);if(j.nodeType===1&&!f._data(j,"parsedAttrs")){g=j.attributes;for(i=g.length;k<i;k++)h=g[k].name,h.indexOf("data-")===0&&(h=f.camelCase(h.substring(5)),l(j,h,m[h]));f._data(j,"parsedAttrs",!0)}}return m}if(typeof a=="object")return this.each(function(){f.data(this,a)});d=a.split(".",2),d[1]=d[1]?"."+d[1]:"",e=d[1]+"!";return f.access(this,function(c){if(c===b){m=this.triggerHandler("getData"+e,[d[0]]),m===b&&j&&(m=f.data(j,a),m=l(j,a,m));return m===b&&d[1]?this.data(d[0]):m}d[1]=c,this.each(function(){var b=f(this);b.triggerHandler("setData"+e,d),f.data(this,a,c),b.triggerHandler("changeData"+e,d)})},null,c,arguments.length>1,null,!1)},removeData:function(a){return this.each(function(){f.removeData(this,a)})}}),f.extend({_mark:function(a,b){a&&(b=(b||"fx")+"mark",f._data(a,b,(f._data(a,b)||0)+1))},_unmark:function(a,b,c){a!==!0&&(c=b,b=a,a=!1);if(b){c=c||"fx";var d=c+"mark",e=a?0:(f._data(b,d)||1)-1;e?f._data(b,d,e):(f.removeData(b,d,!0),n(b,c,"mark"))}},queue:function(a,b,c){var d;if(a){b=(b||"fx")+"queue",d=f._data(a,b),c&&(!d||f.isArray(c)?d=f._data(a,b,f.makeArray(c)):d.push(c));return d||[]}},dequeue:function(a,b){b=b||"fx";var c=f.queue(a,b),d=c.shift(),e={};d==="inprogress"&&(d=c.shift()),d&&(b==="fx"&&c.unshift("inprogress"),f._data(a,b+".run",e),d.call(a,function(){f.dequeue(a,b)},e)),c.length||(f.removeData(a,b+"queue "+b+".run",!0),n(a,b,"queue"))}}),f.fn.extend({queue:function(a,c){var d=2;typeof a!="string"&&(c=a,a="fx",d--);if(arguments.length<d)return f.queue(this[0],a);return c===b?this:this.each(function(){var b=f.queue(this,a,c);a==="fx"&&b[0]!=="inprogress"&&f.dequeue(this,a)})},dequeue:function(a){return this.each(function(){f.dequeue(this,a)})},delay:function(a,b){a=f.fx?f.fx.speeds[a]||a:a,b=b||"fx";return this.queue(b,function(b,c){var d=setTimeout(b,a);c.stop=function(){clearTimeout(d)}})},clearQueue:function(a){return this.queue(a||"fx",[])},promise:function(a,c){function m(){--h||d.resolveWith(e,[e])}typeof a!="string"&&(c=a,a=b),a=a||"fx";var d=f.Deferred(),e=this,g=e.length,h=1,i=a+"defer",j=a+"queue",k=a+"mark",l;while(g--)if(l=f.data(e[g],i,b,!0)||(f.data(e[g],j,b,!0)||f.data(e[g],k,b,!0))&&f.data(e[g],i,f.Callbacks("once memory"),!0))h++,l.add(m);m();return d.promise(c)}});var o=/[\n\t\r]/g,p=/\s+/,q=/\r/g,r=/^(?:button|input)$/i,s=/^(?:button|input|object|select|textarea)$/i,t=/^a(?:rea)?$/i,u=/^(?:autofocus|autoplay|async|checked|controls|defer|disabled|hidden|loop|multiple|open|readonly|required|scoped|selected)$/i,v=f.support.getSetAttribute,w,x,y;f.fn.extend({attr:function(a,b){return f.access(this,f.attr,a,b,arguments.length>1)},removeAttr:function(a){return this.each(function(){f.removeAttr(this,a)})},prop:function(a,b){return f.access(this,f.prop,a,b,arguments.length>1)},removeProp:function(a){a=f.propFix[a]||a;return this.each(function(){try{this[a]=b,delete this[a]}catch(c){}})},addClass:function(a){var b,c,d,e,g,h,i;if(f.isFunction(a))return this.each(function(b){f(this).addClass(a.call(this,b,this.className))});if(a&&typeof a=="string"){b=a.split(p);for(c=0,d=this.length;c<d;c++){e=this[c];if(e.nodeType===1)if(!e.className&&b.length===1)e.className=a;else{g=" "+e.className+" ";for(h=0,i=b.length;h<i;h++)~g.indexOf(" "+b[h]+" ")||(g+=b[h]+" ");e.className=f.trim(g)}}}return this},removeClass:function(a){var c,d,e,g,h,i,j;if(f.isFunction(a))return this.each(function(b){f(this).removeClass(a.call(this,b,this.className))});if(a&&typeof a=="string"||a===b){c=(a||"").split(p);for(d=0,e=this.length;d<e;d++){g=this[d];if(g.nodeType===1&&g.className)if(a){h=(" "+g.className+" ").replace(o," ");for(i=0,j=c.length;i<j;i++)h=h.replace(" "+c[i]+" "," ");g.className=f.trim(h)}else g.className=""}}return this},toggleClass:function(a,b){var c=typeof a,d=typeof b=="boolean";if(f.isFunction(a))return this.each(function(c){f(this).toggleClass(a.call(this,c,this.className,b),b)});return this.each(function(){if(c==="string"){var e,g=0,h=f(this),i=b,j=a.split(p);while(e=j[g++])i=d?i:!h.hasClass(e),h[i?"addClass":"removeClass"](e)}else if(c==="undefined"||c==="boolean")this.className&&f._data(this,"__className__",this.className),this.className=this.className||a===!1?"":f._data(this,"__className__")||""})},hasClass:function(a){var b=" "+a+" ",c=0,d=this.length;for(;c<d;c++)if(this[c].nodeType===1&&(" "+this[c].className+" ").replace(o," ").indexOf(b)>-1)return!0;return!1},val:function(a){var c,d,e,g=this[0];{if(!!arguments.length){e=f.isFunction(a);return this.each(function(d){var g=f(this),h;if(this.nodeType===1){e?h=a.call(this,d,g.val()):h=a,h==null?h="":typeof h=="number"?h+="":f.isArray(h)&&(h=f.map(h,function(a){return a==null?"":a+""})),c=f.valHooks[this.type]||f.valHooks[this.nodeName.toLowerCase()];if(!c||!("set"in c)||c.set(this,h,"value")===b)this.value=h}})}if(g){c=f.valHooks[g.type]||f.valHooks[g.nodeName.toLowerCase()];if(c&&"get"in c&&(d=c.get(g,"value"))!==b)return d;d=g.value;return typeof d=="string"?d.replace(q,""):d==null?"":d}}}}),f.extend({valHooks:{option:{get:function(a){var b=a.attributes.value;return!b||b.specified?a.value:a.text}},select:{get:function(a){var b,c,d,e,g=a.selectedIndex,h=[],i=a.options,j=a.type==="select-one";if(g<0)return null;c=j?g:0,d=j?g+1:i.length;for(;c<d;c++){e=i[c];if(e.selected&&(f.support.optDisabled?!e.disabled:e.getAttribute("disabled")===null)&&(!e.parentNode.disabled||!f.nodeName(e.parentNode,"optgroup"))){b=f(e).val();if(j)return b;h.push(b)}}if(j&&!h.length&&i.length)return f(i[g]).val();return h},set:function(a,b){var c=f.makeArray(b);f(a).find("option").each(function(){this.selected=f.inArray(f(this).val(),c)>=0}),c.length||(a.selectedIndex=-1);return c}}},attrFn:{val:!0,css:!0,html:!0,text:!0,data:!0,width:!0,height:!0,offset:!0},attr:function(a,c,d,e){var g,h,i,j=a.nodeType;if(!!a&&j!==3&&j!==8&&j!==2){if(e&&c in f.attrFn)return f(a)[c](d);if(typeof a.getAttribute=="undefined")return f.prop(a,c,d);i=j!==1||!f.isXMLDoc(a),i&&(c=c.toLowerCase(),h=f.attrHooks[c]||(u.test(c)?x:w));if(d!==b){if(d===null){f.removeAttr(a,c);return}if(h&&"set"in h&&i&&(g=h.set(a,d,c))!==b)return g;a.setAttribute(c,""+d);return d}if(h&&"get"in h&&i&&(g=h.get(a,c))!==null)return g;g=a.getAttribute(c);return g===null?b:g}},removeAttr:function(a,b){var c,d,e,g,h,i=0;if(b&&a.nodeType===1){d=b.toLowerCase().split(p),g=d.length;for(;i<g;i++)e=d[i],e&&(c=f.propFix[e]||e,h=u.test(e),h||f.attr(a,e,""),a.removeAttribute(v?e:c),h&&c in a&&(a[c]=!1))}},attrHooks:{type:{set:function(a,b){if(r.test(a.nodeName)&&a.parentNode)f.error("type property can't be changed");else if(!f.support.radioValue&&b==="radio"&&f.nodeName(a,"input")){var c=a.value;a.setAttribute("type",b),c&&(a.value=c);return b}}},value:{get:function(a,b){if(w&&f.nodeName(a,"button"))return w.get(a,b);return b in a?a.value:null},set:function(a,b,c){if(w&&f.nodeName(a,"button"))return w.set(a,b,c);a.value=b}}},propFix:{tabindex:"tabIndex",readonly:"readOnly","for":"htmlFor","class":"className",maxlength:"maxLength",cellspacing:"cellSpacing",cellpadding:"cellPadding",rowspan:"rowSpan",colspan:"colSpan",usemap:"useMap",frameborder:"frameBorder",contenteditable:"contentEditable"},prop:function(a,c,d){var e,g,h,i=a.nodeType;if(!!a&&i!==3&&i!==8&&i!==2){h=i!==1||!f.isXMLDoc(a),h&&(c=f.propFix[c]||c,g=f.propHooks[c]);return d!==b?g&&"set"in g&&(e=g.set(a,d,c))!==b?e:a[c]=d:g&&"get"in g&&(e=g.get(a,c))!==null?e:a[c]}},propHooks:{tabIndex:{get:function(a){var c=a.getAttributeNode("tabindex");return c&&c.specified?parseInt(c.value,10):s.test(a.nodeName)||t.test(a.nodeName)&&a.href?0:b}}}}),f.attrHooks.tabindex=f.propHooks.tabIndex,x={get:function(a,c){var d,e=f.prop(a,c);return e===!0||typeof e!="boolean"&&(d=a.getAttributeNode(c))&&d.nodeValue!==!1?c.toLowerCase():b},set:function(a,b,c){var d;b===!1?f.removeAttr(a,c):(d=f.propFix[c]||c,d in a&&(a[d]=!0),a.setAttribute(c,c.toLowerCase()));return c}},v||(y={name:!0,id:!0,coords:!0},w=f.valHooks.button={get:function(a,c){var d;d=a.getAttributeNode(c);return d&&(y[c]?d.nodeValue!=="":d.specified)?d.nodeValue:b},set:function(a,b,d){var e=a.getAttributeNode(d);e||(e=c.createAttribute(d),a.setAttributeNode(e));return e.nodeValue=b+""}},f.attrHooks.tabindex.set=w.set,f.each(["width","height"],function(a,b){f.attrHooks[b]=f.extend(f.attrHooks[b],{set:function(a,c){if(c===""){a.setAttribute(b,"auto");return c}}})}),f.attrHooks.contenteditable={get:w.get,set:function(a,b,c){b===""&&(b="false"),w.set(a,b,c)}}),f.support.hrefNormalized||f.each(["href","src","width","height"],function(a,c){f.attrHooks[c]=f.extend(f.attrHooks[c],{get:function(a){var d=a.getAttribute(c,2);return d===null?b:d}})}),f.support.style||(f.attrHooks.style={get:function(a){return a.style.cssText.toLowerCase()||b},set:function(a,b){return a.style.cssText=""+b}}),f.support.optSelected||(f.propHooks.selected=f.extend(f.propHooks.selected,{get:function(a){var b=a.parentNode;b&&(b.selectedIndex,b.parentNode&&b.parentNode.selectedIndex);return null}})),f.support.enctype||(f.propFix.enctype="encoding"),f.support.checkOn||f.each(["radio","checkbox"],function(){f.valHooks[this]={get:function(a){return a.getAttribute("value")===null?"on":a.value}}}),f.each(["radio","checkbox"],function(){f.valHooks[this]=f.extend(f.valHooks[this],{set:function(a,b){if(f.isArray(b))return a.checked=f.inArray(f(a).val(),b)>=0}})});var z=/^(?:textarea|input|select)$/i,A=/^([^\.]*)?(?:\.(.+))?$/,B=/(?:^|\s)hover(\.\S+)?\b/,C=/^key/,D=/^(?:mouse|contextmenu)|click/,E=/^(?:focusinfocus|focusoutblur)$/,F=/^(\w*)(?:#([\w\-]+))?(?:\.([\w\-]+))?$/,G=function(-a){var b=F.exec(a);b&&(b[1]=(b[1]||"").toLowerCase(),b[3]=b[3]&&new RegExp("(?:^|\\s)"+b[3]+"(?:\\s|$)"));return b},H=function(a,b){var c=a.attributes||{};return(!b[1]||a.nodeName.toLowerCase()===b[1])&&(!b[2]||(c.id||{}).value===b[2])&&(!b[3]||b[3].test((c["class"]||{}).value))},I=function(a){return f.event.special.hover?a:a.replace(B,"mouseenter$1 mouseleave$1")};f.event={add:function(a,c,d,e,g){var h,i,j,k,l,m,n,o,p,q,r,s;if(!(a.nodeType===3||a.nodeType===8||!c||!d||!(h=f._data(a)))){d.handler&&(p=d,d=p.handler,g=p.selector),d.guid||(d.guid=f.guid++),j=h.events,j||(h.events=j={}),i=h.handle,i||(h.handle=i=function(a){return typeof f!="undefined"&&(!a||f.event.triggered!==a.type)?f.event.dispatch.apply(i.elem,arguments):b},i.elem=a),c=f.trim(I(c)).split(" ");for(k=0;k<c.length;k++){l=A.exec(c[k])||[],m=l[1],n=(l[2]||"").split(".").sort(),s=f.event.special[m]||{},m=(g?s.delegateType:s.bindType)||m,s=f.event.special[m]||{},o=f.extend({type:m,origType:l[1],data:e,handler:d,guid:d.guid,selector:g,quick:g&&G(g),namespace:n.join(".")},p),r=j[m];if(!r){r=j[m]=[],r.delegateCount=0;if(!s.setup||s.setup.call(a,e,n,i)===!1)a.addEventListener?a.addEventListener(m,i,!1):a.attachEvent&&a.attachEvent("on"+m,i)}s.add&&(s.add.call(a,o),o.handler.guid||(o.handler.guid=d.guid)),g?r.splice(r.delegateCount++,0,o):r.push(o),f.event.global[m]=!0}a=null}},global:{},remove:function(a,b,c,d,e){var g=f.hasData(a)&&f._data(a),h,i,j,k,l,m,n,o,p,q,r,s;if(!!g&&!!(o=g.events)){b=f.trim(I(b||"")).split(" ");for(h=0;h<b.length;h++){i=A.exec(b[h])||[],j=k=i[1],l=i[2];if(!j){for(j in o)f.event.remove(a,j+b[h],c,d,!0);continue}p=f.event.special[j]||{},j=(d?p.delegateType:p.bindType)||j,r=o[j]||[],m=r.length,l=l?new RegExp("(^|\\.)"+l.split(".").sort().join("\\.(?:.*\\.)?")+"(\\.|$)"):null;for(n=0;n<r.length;n++)s=r[n],(e||k===s.origType)&&(!c||c.guid===s.guid)&&(!l||l.test(s.namespace))&&(!d||d===s.selector||d==="**"&&s.selector)&&(r.splice(n--,1),s.selector&&r.delegateCount--,p.remove&&p.remove.call(a,s));r.length===0&&m!==r.length&&((!p.teardown||p.teardown.call(a,l)===!1)&&f.removeEvent(a,j,g.handle),delete o[j])}f.isEmptyObject(o)&&(q=g.handle,q&&(q.elem=null),f.removeData(a,["events","handle"],!0))}},customEvent:{getData:!0,setData:!0,changeData:!0},trigger:function(c,d,e,g){if(!e||e.nodeType!==3&&e.nodeType!==8){var h=c.type||c,i=[],j,k,l,m,n,o,p,q,r,s;if(E.test(h+f.event.triggered))return;h.indexOf("!")>=0&&(h=h.slice(0,-1),k=!0),h.indexOf(".")>=0&&(i=h.split("."),h=i.shift(),i.sort());if((!e||f.event.customEvent[h])&&!f.event.global[h])return;c=typeof c=="object"?c[f.expando]?c:new f.Event(h,c):new f.Event(h),c.type=h,c.isTrigger=!0,c.exclusive=k,c.namespace=i.join("."),c.namespace_re=c.namespace?new RegExp("(^|\\.)"+i.join("\\.(?:.*\\.)?")+"(\\.|$)"):null,o=h.indexOf(":")<0?"on"+h:"";if(!e){j=f.cache;for(l in j)j[l].events&&j[l].events[h]&&f.event.trigger(c,d,j[l].handle.elem,!0);return}c.result=b,c.target||(c.target=e),d=d!=null?f.makeArray(d):[],d.unshift(c),p=f.event.special[h]||{};if(p.trigger&&p.trigger.apply(e,d)===!1)return;r=[[e,p.bindType||h]];if(!g&&!p.noBubble&&!f.isWindow(e)){s=p.delegateType||h,m=E.test(s+h)?e:e.parentNode,n=null;for(;m;m=m.parentNode)r.push([m,s]),n=m;n&&n===e.ownerDocument&&r.push([n.defaultView||n.parentWindow||a,s])}for(l=0;l<r.length&&!c.isPropagationStopped();l++)m=r[l][0],c.type=r[l][1],q=(f._data(m,"events")||{})[c.type]&&f._data(m,"handle"),q&&q.apply(m,d),q=o&&m[o],q&&f.acceptData(m)&&q.apply(m,d)===!1&&c.preventDefault();c.type=h,!g&&!c.isDefaultPrevented()&&(!p._default||p._default.apply(e.ownerDocument,d)===!1)&&(h!=="click"||!f.nodeName(e,"a"))&&f.acceptData(e)&&o&&e[h]&&(h!=="focus"&&h!=="blur"||c.target.offsetWidth!==0)&&!f.isWindow(e)&&(n=e[o],n&&(e[o]=null),f.event.triggered=h,e[h](),f.event.triggered=b,n&&(e[o]=n));return c.result}},dispatch:function(c){c=f.event.fix(c||a.event);var d=(f._data(this,"events")||{})[c.type]||[],e=d.delegateCount,g=[].slice.call(arguments,0),h=!c.exclusive&&!c.namespace,i=f.event.special[c.type]||{},j=[],k,l,m,n,o,p,q,r,s,t,u;g[0]=c,c.delegateTarget=this;if(!i.preDispatch||i.preDispatch.call(this,c)!==!1){if(e&&(!c.button||c.type!=="click")){n=f(this),n.context=this.ownerDocument||this;for(m=c.target;m!=this;m=m.parentNode||this)if(m.disabled!==!0){p={},r=[],n[0]=m;for(k=0;k<e;k++)s=d[k],t=s.selector,p[t]===b&&(p[t]=s.quick?H(m,s.quick):n.is(t)),p[t]&&r.push(s);r.length&&j.push({elem:m,matches:r})}}d.length>e&&j.push({elem:this,matches:d.slice(e)});for(k=0;k<j.length&&!c.isPropagationStopped();k++){q=j[k],c.currentTarget=q.elem;for(l=0;l<q.matches.length&&!c.isImmediatePropagationStopped();l++){s=q.matches[l];if(h||!c.namespace&&!s.namespace||c.namespace_re&&c.namespace_re.test(s.namespace))c.data=s.data,c.handleObj=s,o=((f.event.special[s.origType]||{}).handle||s.handler).apply(q.elem,g),o!==b&&(c.result=o,o===!1&&(c.preventDefault(),c.stopPropagation()))}}i.postDispatch&&i.postDispatch.call(this,c);return c.result}},props:"attrChange attrName relatedNode srcElement altKey bubbles cancelable ctrlKey currentTarget eventPhase metaKey relatedTarget shiftKey target timeStamp view which".split(" "),fixHooks:{},keyHooks:{props:"char charCode key keyCode".split(" "),filter:function(a,b){a.which==null&&(a.which=b.charCode!=null?b.charCode:b.keyCode);return a}},mouseHooks:{props:"button buttons clientX clientY fromElement offsetX offsetY pageX pageY screenX screenY toElement".split(" "),filter:function(a,d){var e,f,g,h=d.button,i=d.fromElement;a.pageX==null&&d.clientX!=null&&(e=a.target.ownerDocument||c,f=e.documentElement,g=e.body,a.pageX=d.clientX+(f&&f.scrollLeft||g&&g.scrollLeft||0)-(f&&f.clientLeft||g&&g.clientLeft||0),a.pageY=d.clientY+(f&&f.scrollTop||g&&g.scrollTop||0)-(f&&f.clientTop||g&&g.clientTop||0)),!a.relatedTarget&&i&&(a.relatedTarget=i===a.target?d.toElement:i),!a.which&&h!==b&&(a.which=h&1?1:h&2?3:h&4?2:0);return a}},fix:function(a){if(a[f.expando])return a;var d,e,g=a,h=f.event.fixHooks[a.type]||{},i=h.props?this.props.concat(h.props):this.props;a=f.Event(g);for(d=i.length;d;)e=i[--d],a[e]=g[e];a.target||(a.target=g.srcElement||c),a.target.nodeType===3&&(a.target=a.target.parentNode),a.metaKey===b&&(a.metaKey=a.ctrlKey);return h.filter?h.filter(a,g):a},special:{ready:{setup:f.bindReady},load:{noBubble:!0},focus:{delegateType:"focusin"},blur:{delegateType:"focusout"},beforeunload:{setup:function(a,b,c){f.isWindow(this)&&(this.onbeforeunload=c)},teardown:function(a,b){this.onbeforeunload===b&&(this.onbeforeunload=null)}}},simulate:function(a,b,c,d){var e=f.extend(new f.Event,c,{type:a,isSimulated:!0,originalEvent:{}});d?f.event.trigger(e,null,b):f.event.dispatch.call(b,e),e.isDefaultPrevented()&&c.preventDefault()}},f.event.handle=f.event.dispatch,f.removeEvent=c.removeEventListener?function(a,b,c){a.removeEventListener&&a.removeEventListener(b,c,!1)}:function(a,b,c){a.detachEvent&&a.detachEvent("on"+b,c)},f.Event=function(a,b){if(!(this instanceof f.Event))return new f.Event(a,b);a&&a.type?(this.originalEvent=a,this.type=a.type,this.isDefaultPrevented=a.defaultPrevented||a.returnValue===!1||a.getPreventDefault&&a.getPreventDefault()?K:J):this.type=a,b&&f.extend(this,b),this.timeStamp=a&&a.timeStamp||f.now(),this[f.expando]=!0},f.Event.prototype={preventDefault:function(){this.isDefaultPrevented=K;var a=this.originalEvent;!a||(a.preventDefault?a.preventDefault():a.returnValue=!1)},stopPropagation:function(){this.isPropagationStopped=K;var a=this.originalEvent;!a||(a.stopPropagation&&a.stopPropagation(),a.cancelBubble=!0)},stopImmediatePropagation:function(){this.isImmediatePropagationStopped=K,this.stopPropagation()},isDefaultPrevented:J,isPropagationStopped:J,isImmediatePropagationStopped:J},f.each({mouseenter:"mouseover",mouseleave:"mouseout"},function(a,b){f.event.special[a]={delegateType:b,bindType:b,handle:function(a){var c=this,d=a.relatedTarget,e=a.handleObj,g=e.selector,h;if(!d||d!==c&&!f.contains(c,d))a.type=e.origType,h=e.handler.apply(this,arguments),a.type=b;return h}}}),f.support.submitBubbles||(f.event.special.submit={setup:function(){if(f.nodeName(this,"form"))return!1;f.event.add(this,"click._submit keypress._submit",function(a){var c=a.target,d=f.nodeName(c,"input")||f.nodeName(c,"button")?c.form:b;d&&!d._submit_attached&&(f.event.add(d,"submit._submit",function(a){a._submit_bubble=!0}),d._submit_attached=!0)})},postDispatch:function(a){a._submit_bubble&&(delete a._submit_bubble,this.parentNode&&!a.isTrigger&&f.event.simulate("submit",this.parentNode,a,!0))},teardown:function(){if(f.nodeName(this,"form"))return!1;f.event.remove(this,"._submit")}}),f.support.changeBubbles||(f.event.special.change={setup:function(){if(z.test(this.nodeName)){if(this.type==="checkbox"||this.type==="radio")f.event.add(this,"propertychange._change",function(a){a.originalEvent.propertyName==="checked"&&(this._just_changed=!0)}),f.event.add(this,"click._change",function(a){this._just_changed&&!a.isTrigger&&(this._just_changed=!1,f.event.simulate("change",this,a,!0))});return!1}f.event.add(this,"beforeactivate._change",function(a){var b=a.target;z.test(b.nodeName)&&!b._change_attached&&(f.event.add(b,"change._change",function(a){this.parentNode&&!a.isSimulated&&!a.isTrigger&&f.event.simulate("change",this.parentNode,a,!0)}),b._change_attached=!0)})},handle:function(a){var b=a.target;if(this!==b||a.isSimulated||a.isTrigger||b.type!=="radio"&&b.type!=="checkbox")return a.handleObj.handler.apply(this,arguments)},teardown:function(){f.event.remove(this,"._change");return z.test(this.nodeName)}}),f.support.focusinBubbles||f.each({focus:"focusin",blur:"focusout"},function(a,b){var d=0,e=function(a){f.event.simulate(b,a.target,f.event.fix(a),!0)};f.event.special[b]={setup:function(){d++===0&&c.addEventListener(a,e,!0)},teardown:function(){--d===0&&c.removeEventListener(a,e,!0)}}}),f.fn.extend({on:function(a,c,d,e,g){var h,i;if(typeof a=="object"){typeof c!="string"&&(d=d||c,c=b);for(i in a)this.on(i,c,d,a[i],g);return this}d==null&&e==null?(e=c,d=c=b):e==null&&(typeof c=="string"?(e=d,d=b):(e=d,d=c,c=b));if(e===!1)e=J;else if(!e)return this;g===1&&(h=e,e=function(a){f().off(a);return h.apply(this,arguments)},e.guid=h.guid||(h.guid=f.guid++));return this.each(function(){f.event.add(this,a,e,d,c)})},one:function(a,b,c,d){return this.on(a,b,c,d,1)},off:function(a,c,d){if(a&&a.preventDefault&&a.handleObj){var e=a.handleObj;f(a.delegateTarget).off(e.namespace?e.origType+"."+e.namespace:e.origType,e.selector,e.handler);return this}if(typeof a=="object"){for(var g in a)this.off(g,c,a[g]);return this}if(c===!1||typeof c=="function")d=c,c=b;d===!1&&(d=J);return this.each(function(){f.event.remove(this,a,d,c)})},bind:function(a,b,c){return this.on(a,null,b,c)},unbind:function(a,b){return this.off(a,null,b)},live:function(a,b,c){f(this.context).on(a,this.selector,b,c);return this},die:function(a,b){f(this.context).off(a,this.selector||"**",b);return this},delegate:function(a,b,c,d){return this.on(b,a,c,d)},undelegate:function(a,b,c){return arguments.length==1?this.off(a,"**"):this.off(b,a,c)},trigger:function(a,b){return this.each(function(){f.event.trigger(a,b,this)})},triggerHandler:function(a,b){if(this[0])return f.event.trigger(a,b,this[0],!0)},toggle:function(a){var b=arguments,c=a.guid||f.guid++,d=0,e=function(c){var e=(f._data(this,"lastToggle"+a.guid)||0)%d;f._data(this,"lastToggle"+a.guid,e+1),c.preventDefault();return b[e].apply(this,arguments)||!1};e.guid=c;while(d<b.length)b[d++].guid=c;return this.click(e)},hover:function(a,b){return this.mouseenter(a).mouseleave(b||a)}}),f.each("blur focus focusin focusout load resize scroll unload click dblclick mousedown mouseup mousemove mouseover mouseout mouseenter mouseleave change select submit keydown keypress keyup error contextmenu".split(" "),function(a,b){f.fn[b]=function(a,c){c==null&&(c=a,a=null);return arguments.length>0?this.on(b,null,a,c):this.trigger(b)},f.attrFn&&(f.attrFn[b]=!0),C.test(b)&&(f.event.fixHooks[b]=f.event.keyHooks),D.test(b)&&(f.event.fixHooks[b]=f.event.mouseHooks)}),function(){function x(a,b,c,e,f,g){for(var h=0,i=e.length;h<i;h++){var j=e[h];if(j){var k=!1;j=j[a];while(j){if(j[d]===c){k=e[j.sizset];break}if(j.nodeType===1){g||(j[d]=c,j.sizset=h);if(typeof b!="string"){if(j===b){k=!0;break}}else if(m.filter(b,[j]).length>0){k=j;break}}j=j[a]}e[h]=k}}}function w(a,b,c,e,f,g){for(var h=0,i=e.length;h<i;h++){var j=e[h];if(j){var k=!1;j=j[a];while(j){if(j[d]===c){k=e[j.sizset];break}j.nodeType===1&&!g&&(j[d]=c,j.sizset=h);if(j.nodeName.toLowerCase()===b){k=j;break}j=j[a]}e[h]=k}}}var a=/((?:\((?:\([^()]+\)|[^()]+)+\)|\[(?:\[[^\[\]]*\]|['"][^'"]*['"]|[^\[\]'"]+)+\]|\\.|[^ >+~,(\[\\]+)+|[>+~])(\s*,\s*)?((?:.|\r|\n)*)/g,d="sizcache"+(Math.random()+"").replace(".",""),e=0,g=Object.prototype.toString,h=!1,i=!0,j=/\\/g,k=/\r\n/g,l=/\W/;[0,0].sort(function(){i=!1;return 0});var m=function(b,d,e,f){e=e||[],d=d||c;var h=d;if(d.nodeType!==1&&d.nodeType!==9)return[];if(!b||typeof b!="string")return e;var i,j,k,l,n,q,r,t,u=!0,v=m.isXML(d),w=[],x=b;do{a.exec(""),i=a.exec(x);if(i){x=i[3],w.push(i[1]);if(i[2]){l=i[3];break}}}while(i);if(w.length>1&&p.exec(b))if(w.length===2&&o.relative[w[0]])j=y(w[0]+w[1],d,f);else{j=o.relative[w[0]]?[d]:m(w.shift(),d);while(w.length)b=w.shift(),o.relative[b]&&(b+=w.shift()),j=y(b,j,f)}else{!f&&w.length>1&&d.nodeType===9&&!v&&o.match.ID.test(w[0])&&!o.match.ID.test(w[w.length-1])&&(n=m.find(w.shift(),d,v),d=n.expr?m.filter(n.expr,n.set)[0]:n.set[0]);if(d){n=f?{expr:w.pop(),set:s(f)}:m.find(w.pop(),w.length===1&&(w[0]==="~"||w[0]==="+")&&d.parentNode?d.parentNode:d,v),j=n.expr?m.filter(n.expr,n.set):n.set,w.length>0?k=s(j):u=!1;while(w.length)q=w.pop(),r=q,o.relative[q]?r=w.pop():q="",r==null&&(r=d),o.relative[q](k,r,v)}else k=w=[]}k||(k=j),k||m.error(q||b);if(g.call(k)==="[object Array]")if(!u)e.push.apply(e,k);else if(d&&d.nodeType===1)for(t=0;k[t]!=null;t++)k[t]&&(k[t]===!0||k[t].nodeType===1&&m.contains(d,k[t]))&&e.push(j[t]);else for(t=0;k[t]!=null;t++)k[t]&&k[t].nodeType===1&&e.push(j[t]);else s(k,e);l&&(m(l,h,e,f),m.uniqueSort(e));return e};m.uniqueSort=function(a){if(u){h=i,a.sort(u);if(h)for(var b=1;b<a.length;b++)a[b]===a[b-1]&&a.splice(b--,1)}return a},m.matches=function(a,b){return m(a,null,null,b)},m.matchesSelector=function(a,b){return m(b,null,null,[a]).length>0},m.find=function(a,b,c){var d,e,f,g,h,i;if(!a)return[];for(e=0,f=o.order.length;e<f;e++){h=o.order[e];if(g=o.leftMatch[h].exec(a)){i=g[1],g.splice(1,1);if(i.substr(i.length-1)!=="\\"){g[1]=(g[1]||"").replace(j,""),d=o.find[h](g,b,c);if(d!=null){a=a.replace(o.match[h],"");break}}}}d||(d=typeof b.getElementsByTagName!="undefined"?b.getElementsByTagName("*"):[]);return{set:d,expr:a}},m.filter=function(a,c,d,e){var f,g,h,i,j,k,l,n,p,q=a,r=[],s=c,t=c&&c[0]&&m.isXML(c[0]);while(a&&c.length){for(h in o.filter)if((f=o.leftMatch[h].exec(a))!=null&&f[2]){k=o.filter[h],l=f[1],g=!1,f.splice(1,1);if(l.substr(l.length-1)==="\\")continue;s===r&&(r=[]);if(o.preFilter[h]){f=o.preFilter[h](f,s,d,r,e,t);if(!f)g=i=!0;else if(f===!0)continue}if(f)for(n=0;(j=s[n])!=null;n++)j&&(i=k(j,f,n,s),p=e^i,d&&i!=null?p?g=!0:s[n]=!1:p&&(r.push(j),g=!0));if(i!==b){d||(s=r),a=a.replace(o.match[h],"");if(!g)return[];break}}if(a===q)if(g==null)m.error(a);else break;q=a}return s},m.error=function(a){throw new Error("Syntax error, unrecognized expression: "+a)};var n=m.getText=function(a){var b,c,d=a.nodeType,e="";if(d){if(d===1||d===9||d===11){if(typeof a.textContent=="string")return a.textContent;if(typeof a.innerText=="string")return a.innerText.replace(k,"");for(a=a.firstChild;a;a=a.nextSibling)e+=n(a)}else if(d===3||d===4)return a.nodeValue}else for(b=0;c=a[b];b++)c.nodeType!==8&&(e+=n(c));return e},o=m.selectors={order:["ID","NAME","TAG"],match:{ID:/#((?:[\w\u00c0-\uFFFF\-]|\\.)+)/,CLASS:/\.((?:[\w\u00c0-\uFFFF\-]|\\.)+)/,NAME:/\[name=['"]*((?:[\w\u00c0-\uFFFF\-]|\\.)+)['"]*\]/,ATTR:/\[\s*((?:[\w\u00c0-\uFFFF\-]|\\.)+)\s*(?:(\S?=)\s*(?:(['"])(.*?)\3|(#?(?:[\w\u00c0-\uFFFF\-]|\\.)*)|)|)\s*\]/,TAG:/^((?:[\w\u00c0-\uFFFF\*\-]|\\.)+)/,CHILD:/:(only|nth|last|first)-child(?:\(\s*(even|odd|(?:[+\-]?\d+|(?:[+\-]?\d*)?n\s*(?:[+\-]\s*\d+)?))\s*\))?/,POS:/:(nth|eq|gt|lt|first|last|even|odd)(?:\((\d*)\))?(?=[^\-]|$)/,PSEUDO:/:((?:[\w\u00c0-\uFFFF\-]|\\.)+)(?:\((['"]?)((?:\([^\)]+\)|[^\(\)]*)+)\2\))?/},leftMatch:{},attrMap:{"class":"className","for":"htmlFor"},attrHandle:{href:function(a){return a.getAttribute("href")},type:function(a){return a.getAttribute("type")}},relative:{"+":function(a,b){var c=typeof b=="string",d=c&&!l.test(b),e=c&&!d;d&&(b=b.toLowerCase());for(var f=0,g=a.length,h;f<g;f++)if(h=a[f]){while((h=h.previousSibling)&&h.nodeType!==1);a[f]=e||h&&h.nodeName.toLowerCase()===b?h||!1:h===b}e&&m.filter(b,a,!0)},">":function(a,b){var c,d=typeof b=="string",e=0,f=a.length;if(d&&!l.test(b)){b=b.toLowerCase();for(;e<f;e++){c=a[e];if(c){var g=c.parentNode;a[e]=g.nodeName.toLowerCase()===b?g:!1}}}else{for(;e<f;e++)c=a[e],c&&(a[e]=d?c.parentNode:c.parentNode===b);d&&m.filter(b,a,!0)}},"":function(a,b,c){var d,f=e++,g=x;typeof b=="string"&&!l.test(b)&&(b=b.toLowerCase(),d=b,g=w),g("parentNode",b,f,a,d,c)},"~":function(a,b,c){var d,f=e++,g=x;typeof b=="string"&&!l.test(b)&&(b=b.toLowerCase(),d=b,g=w),g("previousSibling",b,f,a,d,c)}},find:{ID:function(a,b,c){if(typeof b.getElementById!="undefined"&&!c){var d=b.getElementById(a[1]);return d&&d.parentNode?[d]:[]}},NAME:function(a,b){if(typeof b.getElementsByName!="undefined"){var c=[],d=b.getElementsByName(a[1]);for(var e=0,f=d.length;e<f;e++)d[e].getAttribute("name")===a[1]&&c.push(d[e]);return c.length===0?null:c}},TAG:function(a,b){if(typeof b.getElementsByTagName!="undefined")return b.getElementsByTagName(a[1])}},preFilter:{CLASS:function(a,b,c,d,e,f){a=" "+a[1].replace(j,"")+" ";if(f)return a;for(var g=0,h;(h=b[g])!=null;g++)h&&(e^(h.className&&(" "+h.className+" ").replace(/[\t\n\r]/g," ").indexOf(a)>=0)?c||d.push(h):c&&(b[g]=!1));return!1},ID:function(a){return a[1].replace(j,"")},TAG:function(a,b){return a[1].replace(j,"").toLowerCase()},CHILD:function(a){if(a[1]==="nth"){a[2]||m.error(a[0]),a[2]=a[2].replace(/^\+|\s*/g,"");var b=/(-?)(\d*)(?:n([+\-]?\d*))?/.exec(a[2]==="even"&&"2n"||a[2]==="odd"&&"2n+1"||!/\D/.test(a[2])&&"0n+"+a[2]||a[2]);a[2]=b[1]+(b[2]||1)-0,a[3]=b[3]-0}else a[2]&&m.error(a[0]);a[0]=e++;return a},ATTR:function(a,b,c,d,e,f){var g=a[1]=a[1].replace(j,"");!f&&o.attrMap[g]&&(a[1]=o.attrMap[g]),a[4]=(a[4]||a[5]||"").replace(j,""),a[2]==="~="&&(a[4]=" "+a[4]+" ");return a},PSEUDO:function(b,c,d,e,f){if(b[1]==="not")if((a.exec(b[3])||"").length>1||/^\w/.test(b[3]))b[3]=m(b[3],null,null,c);else{var g=m.filter(b[3],c,d,!0^f);d||e.push.apply(e,g);return!1}else if(o.match.POS.test(b[0])||o.match.CHILD.test(b[0]))return!0;return b},POS:function(a){a.unshift(!0);return a}},filters:{enabled:function(a){return a.disabled===!1&&a.type!=="hidden"},disabled:function(a){return a.disabled===!0},checked:function(a){return a.checked===!0},selected:function(a){a.parentNode&&a.parentNode.selectedIndex;return a.selected===!0},parent:function(a){return!!a.firstChild},empty:function(a){return!a.firstChild},has:function(a,b,c){return!!m(c[3],a).length},header:function(a){return/h\d/i.test(a.nodeName)},text:function(a){var b=a.getAttribute("type"),c=a.type;return a.nodeName.toLowerCase()==="input"&&"text"===c&&(b===c||b===null)},radio:function(a){return a.nodeName.toLowerCase()==="input"&&"radio"===a.type},checkbox:function(a){return a.nodeName.toLowerCase()==="input"&&"checkbox"===a.type},file:function(a){return a.nodeName.toLowerCase()==="input"&&"file"===a.type},password:function(a){return a.nodeName.toLowerCase()==="input"&&"password"===a.type},submit:function(a){var b=a.nodeName.toLowerCase();return(b==="input"||b==="button")&&"submit"===a.type},image:function(a){return a.nodeName.toLowerCase()==="input"&&"image"===a.type},reset:function(a){var b=a.nodeName.toLowerCase();return(b==="input"||b==="button")&&"reset"===a.type},button:function(a){var b=a.nodeName.toLowerCase();return b==="input"&&"button"===a.type||b==="button"},input:function(a){return/input|select|textarea|button/i.test(a.nodeName)},focus:function(a){return a===a.ownerDocument.activeElement}},setFilters:{first:function(a,b){return b===0},last:function(a,b,c,d){return b===d.length-1},even:function(a,b){return b%2===0},odd:function(a,b){return b%2===1},lt:function(a,b,c){return b<c[3]-0},gt:function(a,b,c){return b>c[3]-0},nth:function(a,b,c){return c[3]-0===b},eq:function(a,b,c){return c[3]-0===b}},filter:{PSEUDO:function(a,b,c,d){var e=b[1],f=o.filters[e];if(f)return f(a,c,b,d);if(e==="contains")return(a.textContent||a.innerText||n([a])||"").indexOf(b[3])>=0;if(e==="not"){var g=b[3];for(var h=0,i=g.length;h<i;h++)if(g[h]===a)return!1;return!0}m.error(e)},CHILD:function(a,b){var c,e,f,g,h,i,j,k=b[1],l=a;switch(k){case"only":case"first":while(l=l.previousSibling)if(l.nodeType===1)return!1;if(k==="first")return!0;l=a;case"last":while(l=l.nextSibling)if(l.nodeType===1)return!1;return!0;case"nth":c=b[2],e=b[3];if(c===1&&e===0)return!0;f=b[0],g=a.parentNode;if(g&&(g[d]!==f||!a.nodeIndex)){i=0;for(l=g.firstChild;l;l=l.nextSibling)l.nodeType===1&&(l.nodeIndex=++i);g[d]=f}j=a.nodeIndex-e;return c===0?j===0:j%c===0&&j/c>=0}},ID:function(a,b){return a.nodeType===1&&a.getAttribute("id")===b},TAG:function(a,b){return b==="*"&&a.nodeType===1||!!a.nodeName&&a.nodeName.toLowerCase()===b},CLASS:function(a,b){return(" "+(a.className||a.getAttribute("class"))+" ").indexOf(b)>-1},ATTR:function(a,b){var c=b[1],d=m.attr?m.attr(a,c):o.attrHandle[c]?o.attrHandle[c](a):a[c]!=null?a[c]:a.getAttribute(c),e=d+"",f=b[2],g=b[4];return d==null?f==="!=":!f&&m.attr?d!=null:f==="="?e===g:f==="*="?e.indexOf(g)>=0:f==="~="?(" "+e+" ").indexOf(g)>=0:g?f==="!="?e!==g:f==="^="?e.indexOf(g)===0:f==="$="?e.substr(e.length-g.length)===g:f==="|="?e===g||e.substr(0,g.length+1)===g+"-":!1:e&&d!==!1},POS:function(a,b,c,d){var e=b[2],f=o.setFilters[e];if(f)return f(a,c,b,d)}}},p=o.match.POS,q=function(a,b){return"\\"+(b-0+1)};for(var r in o.match)o.match[r]=new RegExp(o.match[r].source+/(?![^\[]*\])(?![^\(]*\))/.source),o.leftMatch[r]=new RegExp(/(^(?:.|\r|\n)*?)/.source+o.match[r].source.replace(/\\(\d+)/g,q));o.match.globalPOS=p;var s=function(a,b){a=Array.prototype.slice.call(a,0);if(b){b.push.apply(b,a);return b}return a};try{Array.prototype.slice.call(c.documentElement.childNodes,0)[0].nodeType}catch(t){s=function(a,b){var c=0,d=b||[];if(g.call(a)==="[object Array]")Array.prototype.push.apply(d,a);else if(typeof a.length=="number")for(var e=a.length;c<e;c++)d.push(a[c]);else for(;a[c];c++)d.push(a[c]);return d}}var u,v;c.documentElement.compareDocumentPosition?u=function(a,b){if(a===b){h=!0;return 0}if(!a.compareDocumentPosition||!b.compareDocumentPosition)return a.compareDocumentPosition?-1:1;return a.compareDocumentPosition(b)&4?-1:1}:(u=function(a,b){if(a===b){h=!0;return 0}if(a.sourceIndex&&b.sourceIndex)return a.sourceIndex-b.sourceIndex;var c,d,e=[],f=[],g=a.parentNode,i=b.parentNode,j=g;if(g===i)return v(a,b);if(!g)return-1;if(!i)return 1;while(j)e.unshift(j),j=j.parentNode;j=i;while(j)f.unshift(j),j=j.parentNode;c=e.length,d=f.length;for(var k=0;k<c&&k<d;k++)if(e[k]!==f[k])return v(e[k],f[k]);return k===c?v(a,f[k],-1):v(e[k],b,1)},v=function(a,b,c){if(a===b)return c;var d=a.nextSibling;while(d){if(d===b)return-1;d=d.nextSibling}return 1}),function(){var a=c.createElement("div"),d="script"+(new Date).getTime(),e=c.documentElement;a.innerHTML="<a name='"+d+"'/>",e.insertBefore(a,e.firstChild),c.getElementById(d)&&(o.find.ID=function(a,c,d){if(typeof c.getElementById!="undefined"&&!d){var e=c.getElementById(a[1]);return e?e.id===a[1]||typeof e.getAttributeNode!="undefined"&&e.getAttributeNode("id").nodeValue===a[1]?[e]:b:[]}},o.filter.ID=function(a,b){var c=typeof a.getAttributeNode!="undefined"&&a.getAttributeNode("id");return a.nodeType===1&&c&&c.nodeValue===b}),e.removeChild(a),e=a=null}(),function(){var a=c.createElement("div");a.appendChild(c.createComment("")),a.getElementsByTagName("*").length>0&&(o.find.TAG=function(a,b){var c=b.getElementsByTagName(a[1]);if(a[1]==="*"){var d=[];for(var e=0;c[e];e++)c[e].nodeType===1&&d.push(c[e]);c=d}return c}),a.innerHTML="<a href='#'></a>",a.firstChild&&typeof a.firstChild.getAttribute!="undefined"&&a.firstChild.getAttribute("href")!=="#"&&(o.attrHandle.href=function(a){return a.getAttribute("href",2)}),a=null}(),c.querySelectorAll&&function(){var a=m,b=c.createElement("div"),d="__sizzle__";b.innerHTML="<p class='TEST'></p>";if(!b.querySelectorAll||b.querySelectorAll(".TEST").length!==0){m=function(b,e,f,g){e=e||c;if(!g&&!m.isXML(e)){var h=/^(\w+$)|^\.([\w\-]+$)|^#([\w\-]+$)/.exec(b);if(h&&(e.nodeType===1||e.nodeType===9)){if(h[1])return s(e.getElementsByTagName(b),f);if(h[2]&&o.find.CLASS&&e.getElementsByClassName)return s(e.getElementsByClassName(h[2]),f)}if(e.nodeType===9){if(b==="body"&&e.body)return s([e.body],f);if(h&&h[3]){var i=e.getElementById(h[3]);if(!i||!i.parentNode)return s([],f);if(i.id===h[3])return s([i],f)}try{return s(e.querySelectorAll(b),f)}catch(j){}}else if(e.nodeType===1&&e.nodeName.toLowerCase()!=="object"){var k=e,l=e.getAttribute("id"),n=l||d,p=e.parentNode,q=/^\s*[+~]/.test(b);l?n=n.replace(/'/g,"\\$&"):e.setAttribute("id",n),q&&p&&(e=e.parentNode);try{if(!q||p)return s(e.querySelectorAll("[id='"+n+"'] "+b),f)}catch(r){}finally{l||k.removeAttribute("id")}}}return a(b,e,f,g)};for(var e in a)m[e]=a[e];b=null}}(),function(){var a=c.documentElement,b=a.matchesSelector||a.mozMatchesSelector||a.webkitMatchesSelector||a.msMatchesSelector;if(b){var d=!b.call(c.createElement("div"),"div"),e=!1;try{b.call(c.documentElement,"[test!='']:sizzle")}catch(f){e=!0}m.matchesSelector=function(a,c){c=c.replace(/\=\s*([^'"\]]*)\s*\]/g,"='$1']");if(!m.isXML(a))try{if(e||!o.match.PSEUDO.test(c)&&!/!=/.test(c)){var f=b.call(a,c);if(f||!d||a.document&&a.document.nodeType!==11)return f}}catch(g){}return m(c,null,null,[a]).length>0}}}(),function(){var a=c.createElement("div");a.innerHTML="<div class='test e'></div><div class='test'></div>";if(!!a.getElementsByClassName&&a.getElementsByClassName("e").length!==0){a.lastChild.className="e";if(a.getElementsByClassName("e").length===1)return;o.order.splice(1,0,"CLASS"),o.find.CLASS=function(a,b,c){if(typeof b.getElementsByClassName!="undefined"&&!c)return b.getElementsByClassName(a[1])},a=null}}(),c.documentElement.contains?m.contains=function(a,b){return a!==b&&(a.contains?a.contains(b):!0)}:c.documentElement.compareDocumentPosition?m.contains=function(a,b){return!!(a.compareDocumentPosition(b)&16)}:m.contains=function(){return!1},m.isXML=function(a){var b=(a?a.ownerDocument||a:0).documentElement;return b?b.nodeName!=="HTML":!1};var y=function(a,b,c){var d,e=[],f="",g=b.nodeType?[b]:b;while(d=o.match.PSEUDO.exec(a))f+=d[0],a=a.replace(o.match.PSEUDO,"");a=o.relative[a]?a+"*":a;for(var h=0,i=g.length;h<i;h++)m(a,g[h],e,c);return m.filter(f,e)};m.attr=f.attr,m.selectors.attrMap={},f.find=m,f.expr=m.selectors,f.expr[":"]=f.expr.filters,f.unique=m.uniqueSort,f.text=m.getText,f.isXMLDoc=m.isXML,f.contains=m.contains}();var L=/Until$/,M=/^(?:parents|prevUntil|prevAll)/,N=/,/,O=/^.[^:#\[\.,]*$/,P=Array.prototype.slice,Q=f.expr.match.globalPOS,R={children:!0,contents:!0,next:!0,prev:!0};f.fn.extend({find:function(a){var b=this,c,d;if(typeof a!="string")return f(a).filter(function(){for(c=0,d=b.length;c<d;c++)if(f.contains(b[c],this))return!0});var e=this.pushStack("","find",a),g,h,i;for(c=0,d=this.length;c<d;c++){g=e.length,f.find(a,this[c],e);if(c>0)for(h=g;h<e.length;h++)for(i=0;i<g;i++)if(e[i]===e[h]){e.splice(h--,1);break}}return e},has:function(a){var b=f(a);return this.filter(function(){for(var a=0,c=b.length;a<c;a++)if(f.contains(this,b[a]))return!0})},not:function(a){return this.pushStack(T(this,a,!1),"not",a)},filter:function(a){return this.pushStack(T(this,a,!0),"filter",a)},is:function(a){return!!a&&(typeof a=="string"?Q.test(a)?f(a,this.context).index(this[0])>=0:f.filter(a,this).length>0:this.filter(a).length>0)},closest:function(a,b){var c=[],d,e,g=this[0];if(f.isArray(a)){var h=1;while(g&&g.ownerDocument&&g!==b){for(d=0;d<a.length;d++)f(g).is(a[d])&&c.push({selector:a[d],elem:g,level:h});g=g.parentNode,h++}return c}var i=Q.test(a)||typeof a!="string"?f(a,b||this.context):0;for(d=0,e=this.length;d<e;d++){g=this[d];while(g){if(i?i.index(g)>-1:f.find.matchesSelector(g,a)){c.push(g);break}g=g.parentNode;if(!g||!g.ownerDocument||g===b||g.nodeType===11)break}}c=c.length>1?f.unique(c):c;return this.pushStack(c,"closest",a)},index:function(a){if(!a)return this[0]&&this[0].parentNode?this.prevAll().length:-1;if(typeof a=="string")return f.inArray(this[0],f(a));return f.inArray(a.jquery?a[0]:a,this)},add:function(a,b){var c=typeof a=="string"?f(a,b):f.makeArray(a&&a.nodeType?[a]:a),d=f.merge(this.get(),c);return this.pushStack(S(c[0])||S(d[0])?d:f.unique(d))},andSelf:function(){return this.add(this.prevObject)}}),f.each({parent:function(a){var b=a.parentNode;return b&&b.nodeType!==11?b:null},parents:function(a){return f.dir(a,"parentNode")},parentsUntil:function(a,b,c){return f.dir(a,"parentNode",c)},next:function(a){return f.nth(a,2,"nextSibling")},prev:function(a){return f.nth(a,2,"previousSibling")},nextAll:function(a){return f.dir(a,"nextSibling")},prevAll:function(a){return f.dir(a,"previousSibling")},nextUntil:function(a,b,c){return f.dir(a,"nextSibling",c)},prevUntil:function(a,b,c){return f.dir(a,"previousSibling",c)},siblings:function(a){return f.sibling((a.parentNode||{}).firstChild,a)},children:function(a){return f.sibling(a.firstChild)},contents:function(a){return f.nodeName(a,"iframe")?a.contentDocument||a.contentWindow.document:f.makeArray(a.childNodes)}},function(a,b){f.fn[a]=function(c,d){var e=f.map(this,b,c);L.test(a)||(d=c),d&&typeof d=="string"&&(e=f.filter(d,e)),e=this.length>1&&!R[a]?f.unique(e):e,(this.length>1||N.test(d))&&M.test(a)&&(e=e.reverse());return this.pushStack(e,a,P.call(arguments).join(","))}}),f.extend({filter:function(a,b,c){c&&(a=":not("+a+")");return b.length===1?f.find.matchesSelector(b[0],a)?[b[0]]:[]:f.find.matches(a,b)},dir:function(a,c,d){var e=[],g=a[c];while(g&&g.nodeType!==9&&(d===b||g.nodeType!==1||!f(g).is(d)))g.nodeType===1&&e.push(g),g=g[c];return e},nth:function(a,b,c,d){b=b||1;var e=0;for(;a;a=a[c])if(a.nodeType===1&&++e===b)break;return a},sibling:function(a,b){var c=[];for(;a;a=a.nextSibling)a.nodeType===1&&a!==b&&c.push(a);return c}});var V="abbr|article|aside|audio|bdi|canvas|data|datalist|details|figcaption|figure|footer|header|hgroup|mark|meter|nav|output|progress|section|summary|time|video",W=/ jQuery\d+="(?:\d+|null)"/g,X=/^\s+/,Y=/<(?!area|br|col|embed|hr|img|input|link|meta|param)(([\w:]+)[^>]*)\/>/ig,Z=/<([\w:]+)/,$=/<tbody/i,_=/<|&#?\w+;/,ba=/<(?:script|style)/i,bb=/<(?:script|object|embed|option|style)/i,bc=new RegExp("<(?:"+V+")[\\s/>]","i"),bd=/checked\s*(?:[^=]|=\s*.checked.)/i,be=/\/(java|ecma)script/i,bf=/^\s*<!(?:\[CDATA\[|\-\-)/,bg={option:[1,"<select multiple='multiple'>","</select>"],legend:[1,"<fieldset>","</fieldset>"],thead:[1,"<table>","</table>"],tr:[2,"<table><tbody>","</tbody></table>"],td:[3,"<table><tbody><tr>","</tr></tbody></table>"],col:[2,"<table><tbody></tbody><colgroup>","</colgroup></table>"],area:[1,"<map>","</map>"],_default:[0,"",""]},bh=U(c);bg.optgroup=bg.option,bg.tbody=bg.tfoot=bg.colgroup=bg.caption=bg.thead,bg.th=bg.td,f.support.htmlSerialize||(bg._default=[1,"div<div>","</div>"]),f.fn.extend({text:function(a){return f.access(this,function(a){return a===b?f.text(this):this.empty().append((this[0]&&this[0].ownerDocument||c).createTextNode(a))},null,a,arguments.length)},wrapAll:function(a){if(f.isFunction(a))return this.each(function(b){f(this).wrapAll(a.call(this,b))});if(this[0]){var b=f(a,this[0].ownerDocument).eq(0).clone(!0);this[0].parentNode&&b.insertBefore(this[0]),b.map(function(){var a=this;while(a.firstChild&&a.firstChild.nodeType===1)a=a.firstChild;return a}).append(this)}return this},wrapInner:function(a){if(f.isFunction(a))return this.each(function(b){f(this).wrapInner(a.call(this,b))});return this.each(function(){var b=f(this),c=b.contents();c.length?c.wrapAll(a):b.append(a)})},wrap:function(a){var b=f.isFunction(a);return this.each(function(c){f(this).wrapAll(b?a.call(this,c):a)})},unwrap:function(){return this.parent().each(function(){f.nodeName(this,"body")||f(this).replaceWith(this.childNodes)}).end()},append:function(){return this.domManip(arguments,!0,function(a){this.nodeType===1&&this.appendChild(a)})},prepend:function(){return this.domManip(arguments,!0,function(a){this.nodeType===1&&this.insertBefore(a,this.firstChild)})},before:function(){if(this[0]&&this[0].parentNode)return this.domManip(arguments,!1,function(a){this.parentNode.insertBefore(a,this)});if(arguments.length){var a=f-.clean(arguments);a.push.apply(a,this.toArray());return this.pushStack(a,"before",arguments)}},after:function(){if(this[0]&&this[0].parentNode)return this.domManip(arguments,!1,function(a){this.parentNode.insertBefore(a,this.nextSibling)});if(arguments.length){var a=this.pushStack(this,"after",arguments);a.push.apply(a,f.clean(arguments));return a}},remove:function(a,b){for(var c=0,d;(d=this[c])!=null;c++)if(!a||f.filter(a,[d]).length)!b&&d.nodeType===1&&(f.cleanData(d.getElementsByTagName("*")),f.cleanData([d])),d.parentNode&&d.parentNode.removeChild(d);return this},empty:function(){for(var a=0,b;(b=this[a])!=null;a++){b.nodeType===1&&f.cleanData(b.getElementsByTagName("*"));while(b.firstChild)b.removeChild(b.firstChild)}return this},clone:function(a,b){a=a==null?!1:a,b=b==null?a:b;return this.map(function(){return f.clone(this,a,b)})},html:function(a){return f.access(this,function(a){var c=this[0]||{},d=0,e=this.length;if(a===b)return c.nodeType===1?c.innerHTML.replace(W,""):null;if(typeof a=="string"&&!ba.test(a)&&(f.support.leadingWhitespace||!X.test(a))&&!bg[(Z.exec(a)||["",""])[1].toLowerCase()]){a=a.replace(Y,"<$1></$2>");try{for(;d<e;d++)c=this[d]||{},c.nodeType===1&&(f.cleanData(c.getElementsByTagName("*")),c.innerHTML=a);c=0}catch(g){}}c&&this.empty().append(a)},null,a,arguments.length)},replaceWith:function(a){if(this[0]&&this[0].parentNode){if(f.isFunction(a))return this.each(function(b){var c=f(this),d=c.html();c.replaceWith(a.call(this,b,d))});typeof a!="string"&&(a=f(a).detach());return this.each(function(){var b=this.nextSibling,c=this.parentNode;f(this).remove(),b?f(b).before(a):f(c).append(a)})}return this.length?this.pushStack(f(f.isFunction(a)?a():a),"replaceWith",a):this},detach:function(a){return this.remove(a,!0)},domManip:function(a,c,d){var e,g,h,i,j=a[0],k=[];if(!f.support.checkClone&&arguments.length===3&&typeof j=="string"&&bd.test(j))return this.each(function(){f(this).domManip(a,c,d,!0)});if(f.isFunction(j))return this.each(function(e){var g=f(this);a[0]=j.call(this,e,c?g.html():b),g.domManip(a,c,d)});if(this[0]){i=j&&j.parentNode,f.support.parentNode&&i&&i.nodeType===11&&i.childNodes.length===this.length?e={fragment:i}:e=f.buildFragment(a,this,k),h=e.fragment,h.childNodes.length===1?g=h=h.firstChild:g=h.firstChild;if(g){c=c&&f.nodeName(g,"tr");for(var l=0,m=this.length,n=m-1;l<m;l++)d.call(c?bi(this[l],g):this[l],e.cacheable||m>1&&l<n?f.clone(h,!0,!0):h)}k.length&&f.each(k,function(a,b){b.src?f.ajax({type:"GET",global:!1,url:b.src,async:!1,dataType:"script"}):f.globalEval((b.text||b.textContent||b.innerHTML||"").replace(bf,"/*$0*/")),b.parentNode&&b.parentNode.removeChild(b)})}return this}}),f.buildFragment=function(a,b,d){var e,g,h,i,j=a[0];b&&b[0]&&(i=b[0].ownerDocument||b[0]),i.createDocumentFragment||(i=c),a.length===1&&typeof j=="string"&&j.length<512&&i===c&&j.charAt(0)==="<"&&!bb.test(j)&&(f.support.checkClone||!bd.test(j))&&(f.support.html5Clone||!bc.test(j))&&(g=!0,h=f.fragments[j],h&&h!==1&&(e=h)),e||(e=i.createDocumentFragment(),f.clean(a,i,e,d)),g&&(f.fragments[j]=h?e:1);return{fragment:e,cacheable:g}},f.fragments={},f.each({appendTo:"append",prependTo:"prepend",insertBefore:"before",insertAfter:"after",replaceAll:"replaceWith"},function(a,b){f.fn[a]=function(c){var d=[],e=f(c),g=this.length===1&&this[0].parentNode;if(g&&g.nodeType===11&&g.childNodes.length===1&&e.length===1){e[b](this[0]);return this}for(var h=0,i=e.length;h<i;h++){var j=(h>0?this.clone(!0):this).get();f(e[h])[b](j),d=d.concat(j)}return this.pushStack(d,a,e.selector)}}),f.extend({clone:function(a,b,c){var d,e,g,h=f.support.html5Clone||f.isXMLDoc(a)||!bc.test("<"+a.nodeName+">")?a.cloneNode(!0):bo(a);if((!f.support.noCloneEvent||!f.support.noCloneChecked)&&(a.nodeType===1||a.nodeType===11)&&!f.isXMLDoc(a)){bk(a,h),d=bl(a),e=bl(h);for(g=0;d[g];++g)e[g]&&bk(d[g],e[g])}if(b){bj(a,h);if(c){d=bl(a),e=bl(h);for(g=0;d[g];++g)bj(d[g],e[g])}}d=e=null;return h},clean:function(a,b,d,e){var g,h,i,j=[];b=b||c,typeof b.createElement=="undefined"&&(b=b.ownerDocument||b[0]&&b[0].ownerDocument||c);for(var k=0,l;(l=a[k])!=null;k++){typeof l=="number"&&(l+="");if(!l)continue;if(typeof l=="string")if(!_.test(l))l=b.createTextNode(l);else{l=l.replace(Y,"<$1></$2>");var m=(Z.exec(l)||["",""])[1].toLowerCase(),n=bg[m]||bg._default,o=n[0],p=b.createElement("div"),q=bh.childNodes,r;b===c?bh.appendChild(p):U(b).appendChild(p),p.innerHTML=n[1]+l+n[2];while(o--)p=p.lastChild;if(!f.support.tbody){var s=$.test(l),t=m==="table"&&!s?p.firstChild&&p.firstChild.childNodes:n[1]==="<table>"&&!s?p.childNodes:[];for(i=t.length-1;i>=0;--i)f.nodeName(t[i],"tbody")&&!t[i].childNodes.length&&t[i].parentNode.removeChild(t[i])}!f.support.leadingWhitespace&&X.test(l)&&p.insertBefore(b.createTextNode(X.exec(l)[0]),p.firstChild),l=p.childNodes,p&&(p.parentNode.removeChild(p),q.length>0&&(r=q[q.length-1],r&&r.parentNode&&r.parentNode.removeChild(r)))}var u;if(!f.support.appendChecked)if(l[0]&&typeof (u=l.length)=="number")for(i=0;i<u;i++)bn(l[i]);else bn(l);l.nodeType?j.push(l):j=f.merge(j,l)}if(d){g=function(a){return!a.type||be.test(a.type)};for(k=0;j[k];k++){h=j[k];if(e&&f.nodeName(h,"script")&&(!h.type||be.test(h.type)))e.push(h.parentNode?h.parentNode.removeChild(h):h);else{if(h.nodeType===1){var v=f.grep(h.getElementsByTagName("script"),g);j.splice.apply(j,[k+1,0].concat(v))}d.appendChild(h)}}}return j},cleanData:function(a){var b,c,d=f.cache,e=f.event.special,g=f.support.deleteExpando;for(var h=0,i;(i=a[h])!=null;h++){if(i.nodeName&&f.noData[i.nodeName.toLowerCase()])continue;c=i[f.expando];if(c){b=d[c];if(b&&b.events){for(var j in b.events)e[j]?f.event.remove(i,j):f.removeEvent(i,j,b.handle);b.handle&&(b.handle.elem=null)}g?delete i[f.expando]:i.removeAttribute&&i.removeAttribute(f.expando),delete d[c]}}}});var bp=/alpha\([^)]*\)/i,bq=/opacity=([^)]*)/,br=/([A-Z]|^ms)/g,bs=/^[\-+]?(?:\d*\.)?\d+$/i,bt=/^-?(?:\d*\.)?\d+(?!px)[^\d\s]+$/i,bu=/^([\-+])=([\-+.\de]+)/,bv=/^margin/,bw={position:"absolute",visibility:"hidden",display:"block"},bx=["Top","Right","Bottom","Left"],by,bz,bA;f.fn.css=function(a,c){return f.access(this,function(a,c,d){return d!==b?f.style(a,c,d):f.css(a,c)},a,c,arguments.length>1)},f.extend({cssHooks:{opacity:{get:function(a,b){if(b){var c=by(a,"opacity");return c===""?"1":c}return a.style.opacity}}},cssNumber:{fillOpacity:!0,fontWeight:!0,lineHeight:!0,opacity:!0,orphans:!0,widows:!0,zIndex:!0,zoom:!0},cssProps:{"float":f.support.cssFloat?"cssFloat":"styleFloat"},style:function(a,c,d,e){if(!!a&&a.nodeType!==3&&a.nodeType!==8&&!!a.style){var g,h,i=f.camelCase(c),j=a.style,k=f.cssHooks[i];c=f.cssProps[i]||i;if(d===b){if(k&&"get"in k&&(g=k.get(a,!1,e))!==b)return g;return j[c]}h=typeof d,h==="string"&&(g=bu.exec(d))&&(d=+(g[1]+1)*+g[2]+parseFloat(f.css(a,c)),h="number");if(d==null||h==="number"&&isNaN(d))return;h==="number"&&!f.cssNumber[i]&&(d+="px");if(!k||!("set"in k)||(d=k.set(a,d))!==b)try{j[c]=d}catch(l){}}},css:function(a,c,d){var e,g;c=f.camelCase(c),g=f.cssHooks[c],c=f.cssProps[c]||c,c==="cssFloat"&&(c="float");if(g&&"get"in g&&(e=g.get(a,!0,d))!==b)return e;if(by)return by(a,c)},swap:function(a,b,c){var d={},e,f;for(f in b)d[f]=a.style[f],a.style[f]=b[f];e=c.call(a);for(f in b)a.style[f]=d[f];return e}}),f.curCSS=f.css,c.defaultView&&c.defaultView.getComputedStyle&&(bz=function(a,b){var c,d,e,g,h=a.style;b=b.replace(br,"-$1").toLowerCase(),(d=a.ownerDocument.defaultView)&&(e=d.getComputedStyle(a,null))&&(c=e.getPropertyValue(b),c===""&&!f.contains(a.ownerDocument.documentElement,a)&&(c=f.style(a,b))),!f.support.pixelMargin&&e&&bv.test(b)&&bt.test(c)&&(g=h.width,h.width=c,c=e.width,h.width=g);return c}),c.documentElement.currentStyle&&(bA=function(a,b){var c,d,e,f=a.currentStyle&&a.currentStyle[b],g=a.style;f==null&&g&&(e=g[b])&&(f=e),bt.test(f)&&(c=g.left,d=a.runtimeStyle&&a.runtimeStyle.left,d&&(a.runtimeStyle.left=a.currentStyle.left),g.left=b==="fontSize"?"1em":f,f=g.pixelLeft+"px",g.left=c,d&&(a.runtimeStyle.left=d));return f===""?"auto":f}),by=bz||bA,f.each(["height","width"],function(a,b){f.cssHooks[b]={get:function(a,c,d){if(c)return a.offsetWidth!==0?bB(a,b,d):f.swap(a,bw,function(){return bB(a,b,d)})},set:function(a,b){return bs.test(b)?b+"px":b}}}),f.support.opacity||(f.cssHooks.opacity={get:function(a,b){return bq.test((b&&a.currentStyle?a.currentStyle.filter:a.style.filter)||"")?parseFloat(RegExp.$1)/100+"":b?"1":""},set:function(a,b){var c=a.style,d=a.currentStyle,e=f.isNumeric(b)?"alpha(opacity="+b*100+")":"",g=d&&d.filter||c.filter||"";c.zoom=1;if(b>=1&&f.trim(g.replace(bp,""))===""){c.removeAttribute("filter");if(d&&!d.filter)return}c.filter=bp.test(g)?g.replace(bp,e):g+" "+e}}),f(function(){f.support.reliableMarginRight||(f.cssHooks.marginRight={get:function(a,b){return f.swap(a,{display:"inline-block"},function(){return b?by(a,"margin-right"):a.style.marginRight})}})}),f.expr&&f.expr.filters&&(f.expr.filters.hidden=function(a){var b=a.offsetWidth,c=a.offsetHeight;return b===0&&c===0||!f.support.reliableHiddenOffsets&&(a.style&&a.style.display||f.css(a,"display"))==="none"},f.expr.filters.visible=function(a){return!f.expr.filters.hidden(a)}),f.each({margin:"",padding:"",border:"Width"},function(a,b){f.cssHooks[a+b]={expand:function(c){var d,e=typeof c=="string"?c.split(" "):[c],f={};for(d=0;d<4;d++)f[a+bx[d]+b]=e[d]||e[d-2]||e[0];return f}}});var bC=/%20/g,bD=/\[\]$/,bE=/\r?\n/g,bF=/#.*$/,bG=/^(.*?):[ \t]*([^\r\n]*)\r?$/mg,bH=/^(?:color|date|datetime|datetime-local|email|hidden|month|number|password|range|search|tel|text|time|url|week)$/i,bI=/^(?:about|app|app\-storage|.+\-extension|file|res|widget):$/,bJ=/^(?:GET|HEAD)$/,bK=/^\/\//,bL=/\?/,bM=/<script\b[^<]*(?:(?!<\/script>)<[^<]*)*<\/script>/gi,bN=/^(?:select|textarea)/i,bO=/\s+/,bP=/([?&])_=[^&]*/,bQ=/^([\w\+\.\-]+:)(?:\/\/([^\/?#:]*)(?::(\d+))?)?/,bR=f.fn.load,bS={},bT={},bU,bV,bW=["*/"]+["*"];try{bU=e.href}catch(bX){bU=c.createElement("a"),bU.href="",bU=bU.href}bV=bQ.exec(bU.toLowerCase())||[],f.fn.extend({load:function(a,c,d){if(typeof a!="string"&&bR)return bR.apply(this,arguments);if(!this.length)return this;var e=a.indexOf(" ");if(e>=0){var g=a.slice(e,a.length);a=a.slice(0,e)}var h="GET";c&&(f.isFunction(c)?(d=c,c=b):typeof c=="object"&&(c=f.param(c,f.ajaxSettings.traditional),h="POST"));var i=this;f.ajax({url:a,type:h,dataType:"html",data:c,complete:function(a,b,c){c=a.responseText,a.isResolved()&&(a.done(function(a){c=a}),i.html(g?f("<div>").append(c.replace(bM,"")).find(g):c)),d&&i.each(d,[c,b,a])}});return this},serialize:function(){return f.param(this.serializeArray())},serializeArray:function(){return this.map(function(){return this.elements?f.makeArray(this.elements):this}).filter(function(){return this.name&&!this.disabled&&(this.checked||bN.test(this.nodeName)||bH.test(this.type))}).map(function(a,b){var c=f(this).val();return c==null?null:f.isArray(c)?f.map(c,function(a,c){return{name:b.name,value:a.replace(bE,"\r\n")}}):{name:b.name,value:c.replace(bE,"\r\n")}}).get()}}),f.each("ajaxStart ajaxStop ajaxComplete ajaxError ajaxSuccess ajaxSend".split(" "),function(a,b){f.fn[b]=function(a){return this.on(b,a)}}),f.each(["get","post"],function(a,c){f[c]=function(a,d,e,g){f.isFunction(d)&&(g=g||e,e=d,d=b);return f.ajax({type:c,url:a,data:d,success:e,dataType:g})}}),f.extend({getScript:function(a,c){return f.get(a,b,c,"script")},getJSON:function(a,b,c){return f.get(a,b,c,"json")},ajaxSetup:function(a,b){b?b$(a,f.ajaxSettings):(b=a,a=f.ajaxSettings),b$(a,b);return a},ajaxSettings:{url:bU,isLocal:bI.test(bV[1]),global:!0,type:"GET",contentType:"application/x-www-form-urlencoded; charset=UTF-8",processData:!0,async:!0,accepts:{xml:"application/xml, text/xml",html:"text/html",text:"text/plain",json:"application/json, text/javascript","*":bW},contents:{xml:/xml/,html:/html/,json:/json/},responseFields:{xml:"responseXML",text:"responseText"},converters:{"* text":a.String,"text html":!0,"text json":f.parseJSON,"text xml":f.parseXML},flatOptions:{context:!0,url:!0}},ajaxPrefilter:bY(bS),ajaxTransport:bY(bT),ajax:function(a,c){function w(a,c,l,m){if(s!==2){s=2,q&&clearTimeout(q),p=b,n=m||"",v.readyState=a>0?4:0;var o,r,u,w=c,x=l?ca(d,v,l):b,y,z;if(a>=200&&a<300||a===304){if(d.ifModified){if(y=v.getResponseHeader("Last-Modified"))f.lastModified[k]=y;if(z=v.getResponseHeader("Etag"))f.etag[k]=z}if(a===304)w="notmodified",o=!0;else try{r=cb(d,x),w="success",o=!0}catch(A){w="parsererror",u=A}}else{u=w;if(!w||a)w="error",a<0&&(a=0)}v.status=a,v.statusText=""+(c||w),o?h.resolveWith(e,[r,w,v]):h.rejectWith(e,[v,w,u]),v.statusCode(j),j=b,t&&g.trigger("ajax"+(o?"Success":"Error"),[v,d,o?r:u]),i.fireWith(e,[v,w]),t&&(g.trigger("ajaxComplete",[v,d]),--f.active||f.event.trigger("ajaxStop"))}}typeof a=="object"&&(c=a,a=b),c=c||{};var d=f.ajaxSetup({},c),e=d.context||d,g=e!==d&&(e.nodeType||e instanceof f)?f(e):f.event,h=f.Deferred(),i=f.Callbacks("once memory"),j=d.statusCode||{},k,l={},m={},n,o,p,q,r,s=0,t,u,v={readyState:0,setRequestHeader:function(a,b){if(!s){var c=a.toLowerCase();a=m[c]=m[c]||a,l[a]=b}return this},getAllResponseHeaders:function(){return s===2?n:null},getResponseHeader:function(a){var c;if(s===2){if(!o){o={};while(c=bG.exec(n))o[c[1].toLowerCase()]=c[2]}c=o[a.toLowerCase()]}return c===b?null:c},overrideMimeType:function(a){s||(d.mimeType=a);return this},abort:function(a){a=a||"abort",p&&p.abort(a),w(0,a);return this}};h.promise(v),v.success=v.done,v.error=v.fail,v.complete=i.add,v.statusCode=function(a){if(a){var b;if(s<2)for(b in a)j[b]=[j[b],a[b]];else b=a[v.status],v.then(b,b)}return this},d.url=((a||d.url)+"").replace(bF,"").replace(bK,bV[1]+"//"),d.dataTypes=f.trim(d.dataType||"*").toLowerCase().split(bO),d.crossDomain==null&&(r=bQ.exec(d.url.toLowerCase()),d.crossDomain=!(!r||r[1]==bV[1]&&r[2]==bV[2]&&(r[3]||(r[1]==="http:"?80:443))==(bV[3]||(bV[1]==="http:"?80:443)))),d.data&&d.processData&&typeof d.data!="string"&&(d.data=f.param(d.data,d.traditional)),bZ(bS,d,c,v);if(s===2)return!1;t=d.global,d.type=d.type.toUpperCase(),d.hasContent=!bJ.test(d.type),t&&f.active++===0&&f.event.trigger("ajaxStart");if(!d.hasContent){d.data&&(d.url+=(bL.test(d.url)?"&":"?")+d.data,delete d.data),k=d.url;if(d.cache===!1){var x=f.now(),y=d.url.replace(bP,"$1_="+x);d.url=y+(y===d.url?(bL.test(d.url)?"&":"?")+"_="+x:"")}}(d.data&&d.hasContent&&d.contentType!==!1||c.contentType)&&v.setRequestHeader("Content-Type",d.contentType),d.ifModified&&(k=k||d.url,f.lastModified[k]&&v.setRequestHeader("If-Modified-Since",f.lastModified[k]),f.etag[k]&&v.setRequestHeader("If-None-Match",f.etag[k])),v.setRequestHeader("Accept",d.dataTypes[0]&&d.accepts[d.dataTypes[0]]?d.accepts[d.dataTypes[0]]+(d.dataTypes[0]!=="*"?", "+bW+"; q=0.01":""):d.accepts["*"]);for(u in d.headers)v.setRequestHeader(u,d.headers[u]);if(d.beforeSend&&(d.beforeSend.call(e,v,d)===!1||s===2)){v.abort();return!1}for(u in{success:1,error:1,complete:1})v[u](d[u]);p=bZ(bT,d,c,v);if(!p)w(-1,"No Transport");else{v.readyState=1,t&&g.trigger("ajaxSend",[v,d]),d.async&&d.timeout>0&&(q=setTimeout(function(){v.abort("timeout")},d.timeout));try{s=1,p.send(l,w)}catch(z){if(s<2)w(-1,z);else throw z}}return v},param:function(a,c){var d=[],e=function(a,b){b=f.isFunction(b)?b():b,d[d.length]=encodeURIComponent(a)+"="+encodeURIComponent(b)};c===b&&(c=f.ajaxSettings.traditional);if(f.isArray(a)||a.jquery&&!f.isPlainObject(a))f.each(a,function(){e(this.name,this.value)});else for(var g in a)b_(g,a[g],c,e);return d.join("&").replace(bC,"+")}}),f.extend({active:0,lastModified:{},etag:{}});var cc=f.now(),cd=/(\=)\?(&|$)|\?\?/i;f.ajaxSetup({jsonp:"callback",jsonpCallback:function(){return f.expando+"_"+cc++}}),f.ajaxPrefilter("json jsonp",function(b,c,d){var e=typeof b.data=="string"&&/^application\/x\-www\-form\-urlencoded/.test(b.contentType);if(b.dataTypes[0]==="jsonp"||b.jsonp!==!1&&(cd.test(b.url)||e&&cd.test(b.data))){var g,h=b.jsonpCallback=f.isFunction(b.jsonpCallback)?b.jsonpCallback():b.jsonpCallback,i=a[h],j=b.url,k=b.data,l="$1"+h+"$2";b.jsonp!==!1&&(j=j.replace(cd,l),b.url===j&&(e&&(k=k.replace(cd,l)),b.data===k&&(j+=(/\?/.test(j)?"&":"?")+b.jsonp+"="+h))),b.url=j,b.data=k,a[h]=function(a){g=[a]},d.always(function(){a[h]=i,g&&f.isFunction(i)&&a[h](g[0])}),b.converters["script json"]=function(){g||f.error(h+" was not called");return g[0]},b.dataTypes[0]="json";return"script"}}),f.ajaxSetup({accepts:{script:"text/javascript, application/javascript, application/ecmascript, application/x-ecmascript"},contents:{script:/javascript|ecmascript/},converters:{"text script":function(a){f.globalEval(a);return a}}}),f.ajaxPrefilter("script",function(a){a.cache===b&&(a.cache=!1),a.crossDomain&&(a.type="GET",a.global=!1)}),f.ajaxTransport("script",function(a){if(a.crossDomain){var d,e=c.head||c.getElementsByTagName("head")[0]||c.documentElement;return{send:function(f,g){d=c.createElement("script"),d.async="async",a.scriptCharset&&(d.charset=a.scriptCharset),d.src=a.url,d.onload=d.onreadystatechange=function(a,c){if(c||!d.readyState||/loaded|complete/.test(d.readyState))d.onload=d.onreadystatechange=null,e&&d.parentNode&&e.removeChild(d),d=b,c||g(200,"success")},e.insertBefore(d,e.firstChild)},abort:function(){d&&d.onload(0,1)}}}});var ce=a.ActiveXObject?function(){for(var a in cg)cg[a](0,1)}:!1,cf=0,cg;f.ajaxSettings.xhr=a.ActiveXObject?function(){return!this.isLocal&&ch()||ci()}:ch,function(a){f.extend(f.support,{ajax:!!a,cors:!!a&&"withCredentials"in a})}(f.ajaxSettings.xhr()),f.support.ajax&&f.ajaxTransport(function(c){if(!c.crossDomain||f.support.cors){var d;return{send:function(e,g){var h=c.xhr(),i,j;c.username?h.open(c.type,c.url,c.async,c.username,c.password):h.open(c.type,c.url,c.async);if(c.xhrFields)for(j in c.xhrFields)h[j]=c.xhrFields[j];c.mimeType&&h.overrideMimeType&&h.overrideMimeType(c.mimeType),!c.crossDomain&&!e["X-Requested-With"]&&(e["X-Requested-With"]="XMLHttpRequest");try{for(j in e)h.setRequestHeader(j,e[j])}catch(k){}h.send(c.hasContent&&c.data||null),d=function(a,e){var j,k,l,m,n;try{if(d&&(e||h.readyState===4)){d=b,i&&(h.onreadystatechange=f.noop,ce&&delete cg[i]);if(e)h.readyState!==4&&h.abort();else{j=h.status,l=h.getAllResponseHeaders(),m={},n=h.responseXML,n&&n.documentElement&&(m.xml=n);try{m.text=h.responseText}catch(a){}try{k=h.statusText}catch(o){k=""}!j&&c.isLocal&&!c.crossDomain?j=m.text?200:404:j===1223&&(j=204)}}}catch(p){e||g(-1,p)}m&&g(j,k,m,l)},!c.async||h.readyState===4?d():(i=++cf,ce&&(cg||(cg={},f(a).unload(ce)),cg[i]=d),h.onreadystatechange=d)},abort:function(){d&&d(0,1)}}}});var cj={},ck,cl,cm=/^(?:toggle|show|hide)$/,cn=/^([+\-]=)?([\d+.\-]+)([a-z%]*)$/i,co,cp=[["height","marginTop","marginBottom","paddingTop","paddingBottom"],["width","marginLeft","marginRight","paddingLeft","paddingRight"],["opacity"]],cq;f.fn.extend({show:function(a,b,c){var d,e;if(a||a===0)return this.animate(ct("show",3),a,b,c);for(var g=0,h=this.length;g<h;g++)d=this[g],d.style&&(e=d.style.display,!f._data(d,"olddisplay")&&e==="none"&&(e=d.style.display=""),(e===""&&f.css(d,"display")==="none"||!f.contains(d.ownerDocument.documentElement,d))&&f._data(d,"olddisplay",cu(d.nodeName)));for(g=0;g<h;g++){d=this[g];if(d.style){e=d.style.display;if(e===""||e==="none")d.style.display=f._data(d,"olddisplay")||""}}return this},hide:function(a,b,c){if(a||a===0)return this.animate(ct("hide",3),a,b,c);var d,e,g=0,h=this.length;for(;g<h;g++)d=this[g],d.style&&(e=f.css(d,"display"),e!=="none"&&!f._data(d,"olddisplay")&&f._data(d,"olddisplay",e));for(g=0;g<h;g++)this[g].style&&(this[g].style.display="none");return this},_toggle:f.fn.toggle,toggle:function(a,b,c){var d=typeof a=="boolean";f.isFunction(a)&&f.isFunction(b)?this._toggle.apply(this,arguments):a==null||d?this.each(function(){var b=d?a:f(this).is(":hidden");f(this)[b?"show":"hide"]()}):this.animate(ct("toggle",3),a,b,c);return this},fadeTo:function(a,b,c,d){return this.filter(":hidden").css("opacity",0).show().end().animate({opacity:b},a,c,d)},animate:function(a,b,c,d){function g(){e.queue===!1&&f._mark(this);var b=f.extend({},e),c=this.nodeType===1,d=c&&f(this).is(":hidden"),g,h,i,j,k,l,m,n,o,p,q;b.animatedProperties={};for(i in a){g=f.camelCase(i),i!==g&&(a[g]=a[i],delete a[i]);if((k=f.cssHooks[g])&&"expand"in k){l=k.expand(a[g]),delete a[g];for(i in l)i in a||(a[i]=l[i])}}for(g in a){h=a[g],f.isArray(h)?(b.animatedProperties[g]=h[1],h=a[g]=h[0]):b.animatedProperties[g]=b.specialEasing&&b.specialEasing[g]||b.easing||"swing";if(h==="hide"&&d||h==="show"&&!d)return b.complete.call(this);c&&(g==="height"||g==="width")&&(b.overflow=[this.style.overflow,this.style.overflowX,this.style.overflowY],f.css(this,"display")==="inline"&&f.css(this,"float")==="none"&&(!f.support.inlineBlockNeedsLayout||cu(this.nodeName)==="inline"?this.style.display="inline-block":this.style.zoom=1))}b.overflow!=null&&(this.style.overflow="hidden");for(i in a)j=new f.fx(this,b,i),h=a[i],cm.test(h)?(q=f._data(this,"toggle"+i)||(h==="toggle"?d?"show":"hide":0),q?(f._data(this,"toggle"+i,q==="show"?"hide":"show"),j[q]()):j[h]()):(m=cn.exec(h),n=j.cur(),m?(o=parseFloat(m[2]),p=m[3]||(f.cssNumber[i]?"":"px"),p!=="px"&&(f.style(this,i,(o||1)+p),n=(o||1)/j.cur()*n,f.style(this,i,n+p)),m[1]&&(o=(m[1]==="-="?-1:1)*o+n),j.custom(n,o,p)):j.custom(n,h,""));return!0}var e=f.speed(b,c,d);if(f.isEmptyObject(a))return this.each(e.complete,[!1]);a=f.extend({},a);return e.queue===!1?this.each(g):this.queue(e.queue,g)},stop:function(a,c,d){typeof a!="string"&&(d=c,c=a,a=b),c&&a!==!1&&this.queue(a||"fx",[]);return this.each(function(){function h(a,b,c){var e=b[c];f.removeData(a,c,!0),e.stop(d)}var b,c=!1,e=f.timers,g=f._data(this);d||f._unmark(!0,this);if(a==null)for(b in g)g[b]&&g[b].stop&&b.indexOf(".run")===b.length-4&&h(this,g,b);else g[b=a+".run"]&&g[b].stop&&h(this,g,b);for(b=e.length;b--;)e[b].elem===this&&(a==null||e[b].queue===a)&&(d?e[b](!0):e[b].saveState(),c=!0,e.splice(b,1));(!d||!c)&&f.dequeue(this,a)})}}),f.each({slideDown:ct("show",1),slideUp:ct("hide",1),slideToggle:ct("toggle",1),fadeIn:{opacity:"show"},fadeOut:{opacity:"hide"},fadeToggle:{opacity:"toggle"}},function(a,b){f.fn[a]=function(a,c,d){return this.animate(b,a,c,d)}}),f.extend({speed:function(a,b,c){var d=a&&typeof a=="object"?f.extend({},a):{complete:c||!c&&b||f.isFunction(a)&&a,duration:a,easing:c&&b||b&&!f.isFunction(b)&&b};d.duration=f.fx.off?0:typeof d.duration=="number"?d.duration:d.duration in f.fx.speeds?f.fx.speeds[d.duration]:f.fx.speeds._default;if(d.queue==null||d.queue===!0)d.queue="fx";d.old=d.complete,d.complete=function(a){f.isFunction(d.old)&&d.old.call(this),d.queue?f.dequeue(this,d.queue):a!==!1&&f._unmark(this)};return d},easing:{linear:function(a){return a},swing:function(a){return-Math.cos(a*Math.PI)/2+.5}},timers:[],fx:function(a,b,c){this.options=b,this.elem=a,this.prop=c,b.orig=b.orig||{}}}),f.fx.prototype={update:function(){this.options.step&&this.options.step.call(this.elem,this.now,this),(f.fx.step[this.prop]||f.fx.step._default)(this)},cur:function(){if(this.elem[this.prop]!=null&&(!this.elem.style||this.elem.style[this.prop]==null))return this.elem[this.prop];var a,b=f.css(this.elem,this.prop);return isNaN(a=parseFloat(b))?!b||b==="auto"?0:b:a},custom:function(a,c,d){function h(a){return e.step(a)}var e=this,g=f.fx;this.startTime=cq||cr(),this.end=c,this.now=this.start=a,this.pos=this.state=0,this.unit=d||this.unit||(f.cssNumber[this.prop]?"":"px"),h.queue=this.options.queue,h.elem=this.elem,h.saveState=function(){f._data(e.elem,"fxshow"+e.prop)===b&&(e.options.hide?f._data(e.elem,"fxshow"+e.prop,e.start):e.options.show&&f._data(e.elem,"fxshow"+e.prop,e.end))},h()&&f.timers.push(h)&&!co&&(co=setInterval(g.tick,g.interval))},show:function(){var a=f._data(this.elem,"fxshow"+this.prop);this.options.orig[this.prop]=a||f.style(this.elem,this.prop),this.options.show=!0,a!==b?this.custom(this.cur(),a):this.custom(this.prop==="width"||this.prop==="height"?1:0,this.cur()),f(this.elem).show()},hide:function(){this.options.orig[this.prop]=f._data(this.elem,"fxshow"+this.prop)||f.style(this.elem,this.prop),this.options.hide=!0,this.custom(this.cur(),0)},step:function(a){var b,c,d,e=cq||cr(),g=!0,h=this.elem,i=this.options;if(a||e>=i.duration+this.startTime){this.now=this.end,this.pos=this.state=1,this.update(),i.animatedProperties[this.prop]=!0;for(b in i.animatedProperties)i.animatedProperties[b]!==!0&&(g=!1);if(g){i.overflow!=null&&!f.support.shrinkWrapBlocks&&f.each(["","X","Y"],function(a,b){h.style["overflow"+b]=i.overflow[a]}),i.hide&&f(h).hide();if(i.hide||i.show)for(b in i.animatedProperties)f.style(h,b,i.orig[b]),f.removeData(h,"fxshow"+b,!0),f.removeData(h,"toggle"+b,!0);d=i.complete,d&&(i.complete=!1,d.call(h))}return!1}i.duration==Infinity?this.now=e:(c=e-this.startTime,this.state=c/i.duration,this.pos=f.easing[i.animatedProperties[this.prop]](this.state,c,0,1,i.duration),this.now=this.start+(this.end-this.start)*this.pos),this.update();return!0}},f.extend(f.fx,{tick:function(){var a,b=f.timers,c=0;for(;c<b.length;c++)a=b[c],!a()&&b[c]===a&&b.splice(c--,1);b.length||f.fx.stop()},interval:13,stop:function(){clearInterval(co),co=null},speeds:{slow:600,fast:200,_default:400},step:{opacity:function(a){f.style(a.elem,"opacity",a.now)},_default:function(a){a.elem.style&&a.elem.style[a.prop]!=null?a.elem.style[a.prop]=a.now+a.unit:a.elem[a.prop]=a.now}}}),f.each(cp.concat.apply([],cp),function(a,b){b.indexOf("margin")&&(f.fx.step[b]=function(a){f.style(a.elem,b,Math.max(0,a.now)+a.unit)})}),f.expr&&f.expr.filters&&(f.expr.filters.animated=function(a){return f.grep(f.timers,function(b){return a===b.elem}).length});var cv,cw=/^t(?:able|d|h)$/i,cx=/^(?:body|html)$/i;"getBoundingClientRect"in c.documentElement?cv=function(a,b,c,d){try{d=a.getBoundingClientRect()}catch(e){}if(!d||!f.contains(c,a))return d?{top:d.top,left:d.left}:{top:0,left:0};var g=b.body,h=cy(b),i=c.clientTop||g.clientTop||0,j=c.clientLeft||g.clientLeft||0,k=h.pageYOffset||f.support.boxModel&&c.scrollTop||g.scrollTop,l=h.pageXOffset||f.support.boxModel&&c.scrollLeft||g.scrollLeft,m=d.top+k-i,n=d.left+l-j;return{top:m,left:n}}:cv=function(a,b,c){var d,e=a.offsetParent,g=a,h=b.body,i=b.defaultView,j=i?i.getComputedStyle(a,null):a.currentStyle,k=a.offsetTop,l=a.offsetLeft;while((a=a.parentNode)&&a!==h&&a!==c){if(f.support.fixedPosition&&j.position==="fixed")break;d=i?i.getComputedStyle(a,null):a.currentStyle,k-=a.scrollTop,l-=a.scrollLeft,a===e&&(k+=a.offsetTop,l+=a.offsetLeft,f.support.doesNotAddBorder&&(!f.support.doesAddBorderForTableAndCells||!cw.test(a.nodeName))&&(k+=parseFloat(d.borderTopWidth)||0,l+=parseFloat(d.borderLeftWidth)||0),g=e,e=a.offsetParent),f.support.subtractsBorderForOverflowNotVisible&&d.overflow!=="visible"&&(k+=parseFloat(d.borderTopWidth)||0,l+=parseFloat(d.borderLeftWidth)||0),j=d}if(j.position==="relative"||j.position==="static")k+=h.offsetTop,l+=h.offsetLeft;f.support.fixedPosition&&j.position==="fixed"&&(k+=Math.max(c.scrollTop,h.scrollTop),l+=Math.max(c.scrollLeft,h.scrollLeft));return{top:k,left:l}},f.fn.offset=function(a){if(arguments.length)return a===b?this:this.each(function(b){f.offset.setOffset(this,a,b)});var c=this[0],d=c&&c.ownerDocument;if(!d)return null;if(c===d.body)return f.offset.bodyOffset(c);return cv(c,d,d.documentElement)},f.offset={bodyOffset:function(a){var b=a.offsetTop,c=a.offsetLeft;f.support.doesNotIncludeMarginInBodyOffset&&(b+=parseFloat(f.css(a,"marginTop"))||0,c+=parseFloat(f.css(a,"marginLeft"))||0);return{top:b,left:c}},setOffset:function(a,b,c){var d=f.css(a,"position");d==="static"&&(a.style.position="relative");var e=f(a),g=e.offset(),h=f.css(a,"top"),i=f.css(a,"left"),j=(d==="absolute"||d==="fixed")&&f.inArray("auto",[h,i])>-1,k={},l={},m,n;j?(l=e.position(),m=l.top,n=l.left):(m=parseFloat(h)||0,n=parseFloat(i)||0),f.isFunction(b)&&(b=b.call(a,c,g)),b.top!=null&&(k.top=b.top-g.top+m),b.left!=null&&(k.left=b.left-g.left+n),"using"in b?b.using.call(a,k):e.css(k)}},f.fn.extend({position:function(){if(!this[0])return null;var a=this[0],b=this.offsetParent(),c=this.offset(),d=cx.test(b[0].nodeName)?{top:0,left:0}:b.offset();c.top-=parseFloat(f.css(a,"marginTop"))||0,c.left-=parseFloat(f.css(a,"marginLeft"))||0,d.top+=parseFloat(f.css(b[0],"borderTopWidth"))||0,d.left+=parseFloat(f.css(b[0],"borderLeftWidth"))||0;return{top:c.top-d.top,left:c.left-d.left}},offsetParent:function(){return this.map(function(){var a=this.offsetParent||c.body;while(a&&!cx.test(a.nodeName)&&f.css(a,"position")==="static")a=a.offsetParent;return a})}}),f.each({scrollLeft:"pageXOffset",scrollTop:"pageYOffset"},function(a,c){var d=/Y/.test(c);f.fn[a]=function(e){return f.access(this,function(a,e,g){var h=cy(a);if(g===b)return h?c in h?h[c]:f.support.boxModel&&h.document.documentElement[e]||h.document.body[e]:a[e];h?h.scrollTo(d?f(h).scrollLeft():g,d?g:f(h).scrollTop()):a[e]=g},a,e,arguments.length,null)}}),f.each({Height:"height",Width:"width"},function(a,c){var d="client"+a,e="scroll"+a,g="offset"+a;f.fn["inner"+a]=function(){var a=this[0];return a?a.style?parseFloat(f.css(a,c,"padding")):this[c]():null},f.fn["outer"+a]=function(a){var b=this[0];return b?b.style?parseFloat(f.css(b,c,a?"margin":"border")):this[c]():null},f.fn[c]=function(a){return f.access(this,function(a,c,h){var i,j,k,l;if(f.isWindow(a)){i=a.document,j=i.documentElement[d];return f.support.boxModel&&j||i.body&&i.body[d]||j}if(a.nodeType===9){i=a.documentElement;if(i[d]>=i[e])return i[d];return Math.max(a.body[e],i[e],a.body[g],i[g])}if(h===b){k=f.css(a,c),l=parseFloat(k);return f.isNumeric(l)?l:k}f(a).css(c,h)},c,a,arguments.length,null)}}),a.jQuery=a.$=f,typeof define=="function"&&define.amd&&define.amd.jQuery&&define("jquery",[],function(){return f})})(window);
− datadir/resources/less_blue.png

binary file changed (291 → absent bytes)

− datadir/resources/less_gray.png

binary file changed (199 → absent bytes)

− datadir/resources/less_small.png

binary file changed (201 → absent bytes)

− datadir/resources/more_blue.png

binary file changed (283 → absent bytes)

− datadir/resources/more_gray.png

binary file changed (203 → absent bytes)

− datadir/resources/more_small.png

binary file changed (202 → absent bytes)

− datadir/resources/search.xml 
@@ -1,21 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">-    <ShortName>Hoogle</ShortName>-    <LongName>Hoogle - Haskell API Search</LongName>-    <Description>-        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.-    </Description>-    <Tags>haskell</Tags>-    <Url type="text/html" template="http://haskell.org/hoogle/?hoogle={searchTerms}"/>-    <Url type="application/x-suggestions+json" template="http://haskell.org/hoogle/?hoogle={searchTerms}&amp;mode=suggest"/>--    <Image height="16" width="16" type="image/png">http://haskell.org/hoogle/res/favicon.png</Image>-    <Image height="64" width="64" type="image/png">http://haskell.org/hoogle/res/favicon64.png</Image>-    <Developer>Neil Mitchell</Developer>-    <AdultContent>false</AdultContent>-    <Language>en-us</Language>-    <OutputEncoding>UTF-8</OutputEncoding>-    <InputEncoding>UTF-8</InputEncoding>-</OpenSearchDescription>
− datadir/resources/spinner.gif

binary file changed (2037 → absent bytes)

− datadir/resources/template.html 
@@ -1,93 +0,0 @@--#export header css js query-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">-<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$ $&queryHyphen$ Hoogle</title>-        <link type="text/css" rel="stylesheet" href="res/hoogle.css?version=$%css$" />-        <link type="image/png" rel="icon" href="res/favicon.png" />-		<link type="image/png" rel="apple-touch-icon" href="res/favicon57.png" />-        <link type="application/opensearchdescription+xml" rel="search" href="res/search.xml" title="Hoogle" />-        <script type="text/javascript" src="res/jquery.js?version=$%js$"> </script>-        <script type="text/javascript" src="res/jquery-cookie.js?version=$%js$"> </script>-        <script type="text/javascript" src="res/hoogle.js?version=$%js$"> </script>-    </head>-    <body>-<div id="links">-    <ul id="top-menu">-        <li id="instant" style="display:none;">-            <a href="javascript:setInstant()">Instant is <span id="instantVal">off</span></a>-        </li>-        <li id="plugin" style="display:none;"><a href="javascript:searchPlugin()">Search plugin</a></li>-        <li><a href="https://github.com/ndmitchell/hoogle/blob/master/README.md">Manual</a></li>-        <li>$#homepage$</li>-    </ul>-</div>-<form action="." method="get" id="search">-    <a id="logo" href="http://haskell.org/hoogle/">-        <img src="res/hoogle.png" width="160" height="58" alt="Hoogle"-    /></a>-    <input name="hoogle" id="hoogle" class="HOOGLE_REAL" type="text" autocomplete="off" accesskey="1" value="$&query$" />-    <input id="submit" type="submit" value="Search" />-</form>-<div id="body">---#homepage-<a href="http://www.haskell.org/">haskell.org</a>---#export footer version-            <div class="push"></div>-        </div>-        <div id="footer">&copy; <a href="http://community.haskell.org/~ndm/">Neil Mitchell</a> 2004-2013, version $&version$</div>-    </body>-</html>---#search-<a href="?hoogle=$%query$">$&query$</a>---#export welcome-<h1><b>Welcome to Hoogle</b></h1>-<ul id="left">-<li><b>Links</b></li>-<li><a href="http://haskell.org/">Haskell.org</a></li>-<li><a href="http://hackage.haskell.org/">Hackage</a></li>-<li><a href="http://www.haskell.org/ghc/docs/latest/html/users_guide/">GHC Manual</a></li>-<li><a href="http://www.haskell.org/ghc/docs/latest/html/libraries/">Libraries</a></li>-</ul>-<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/>-    $query=map$ $#search$<br/>-    $query=(a -> b) -> [a] -> [b]$ $#search$<br/>-    $query=Ord a => [a] -> [a]$ $#search$<br/>-    $query=Data.Map.insert$ $#search$<br/>-	<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://community.haskell.org/~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>---#export parseError-<h1>$!errFormat$</h1>-<p>-	<b>Parse error:</b> $&errMessage$-</p><p>-	For information on what queries should look like, see the-	<a href="http://www.haskell.org/haskellwiki/Hoogle">user manual</a>.-</p>
− datadir/resources/template_example.html 
@@ -1,11 +0,0 @@--#homepage-<a href='http://www.example.com/'>example.com</a>---#export welcome-<h1><b>Welcome to Hoogle</b></h1>-<p>-    This copy of Hoogle overrides a few example settings, to allow you to better integrate it-    in any local installations.-</p>
− datadir/testdata.txt 
@@ -1,58 +0,0 @@--- data for tests.txt--@package testdata--module Testdata--() :: ()-(,) :: a -> b -> (a,b)-type FilePath = String-type String = [Char]-data Unit-Unit :: Unit-data Maybe a-Just :: a -> Maybe a-Nothing :: Maybe a-id :: a -> a-unsafeCoerce :: a -> b-map :: (a -> b) -> [a] -> [b]-flipmap :: [a] -> (a -> b) -> [b]-fmap :: Functor m => (a -> b) -> m a -> m b-unfmap :: (a -> b) -> m a -> m b-eq :: Eq a => (a -> b) -> m a -> m b-fst :: (a,b) -> a-snd :: (a,b) -> b-(==) :: Eq a => a -> a -> Bool-instance Eq Bool-instance Functor []-not :: Bool -> Bool-string :: String-chars :: [Char]--int2 :: Char -> Int -> Int-instance Ord Bar-ordId :: Ord a => a -> a-nonId :: Non a => a -> a---- check bug # 352-( # ) :: Int--everywhere :: Data a => (forall local. Data local => local -> local) -> a -> a-class Eq2 a b => Ord2 a b | a -> b--@entry package pkg1-@entry package pkg2--module Foo.Bar---- | Documentation for <i>foo_bar</i>-foo_bar :: Unit-fst :: (Unit,Unit) -> Unit-fst2 :: (Unit,Unit) -> Unit--module Bar.Foo-bar_foo :: Unit-fst :: (Bar,Bar) -> Bar--type Alias1 a = Alias2 a-aliases :: Alias1 (Alias1 a) -> a
− datadir/tests.txt 
@@ -1,127 +0,0 @@--- these tests only rely on the testdata database--id +testdata-id--map +testdata-map-fmap-@reorder unfmap--"(a -> b) -> [a] -> [b]" +testdata-map-fmap-unfmap--"(a -> b) -> [a] -> [b]" +testdata-map-flipmap--"a -> b" +testdata-unsafeCoerce--"(c,d) -> d" +testdata-snd-fst--"(c,d) -> c" +testdata-fst-snd--"Bool -> Bool -> Bool" +testdata-(==)--"Bool -> Bool" +testdata-not-(==)--:: String +testdata-string-chars--[Char] +testdata-chars-string--"Functor m => (a -> b) -> m a -> m b" +testdata-fmap-unfmap-eq---- tests that arguments are not reused-"Int -> Int -> Int" +testdata-@not int2---- test that instances are applied properly-"Bar -> Bar" +testdata-ordId-@reorder id-nonId---- test that packages can be searched for-pkg +testdata-pkg1-@reorder pkg2--map --link +testdata-Testdata map :: (a -> b) -> [a] -> [b] -- http://hackage.haskell.org/packages/archive/testdata/latest/doc/html/Testdata.html#v:map--== --link +testdata-Testdata (==) :: Eq a => a -> a -> Bool -- http://hackage.haskell.org/packages/archive/testdata/latest/doc/html/Testdata.html#v:-61--61----- check for perservation of forall-everywhere +testdata-everywhere :: Data a => (forall local. Data local => local -> local) -> a -> a---- preservation of functional dependencies-rd2 +testdata-class Eq2 a b => Ord2 a b | a -> b--:: Just a +testdata-Did you mean: :: Maybe a +testdata--:: Maybe +testdata-Did you mean: :: Maybe a +testdata---- check that () is known, not a warning, and is the first result-:: () +testdata-@now () :: ()--to +testdata-No results--a to b +testdata-Did you mean: a -> b +testdata--a to to b +testdata-No results---- case insensitive module names-BAR.bar_foo +testdata-bar_foo---- lower case module prefixes via .-bar.bar_foo +testdata-bar_foo---- #372, proper searching for modules-foo.bar_foo +testdata-bar_foo--bar.foo.bar_foo +testdata-bar_foo--bar.fo.bar_foo +testdata-bar_foo--ba.foo.bar_foo +testdata-@now No results--ar.foo bar_foo +testdata-@now No results--"Alias1 (Alias1 a) -> a" +testdata-aliases--"Alias2 (Alias2 a) -> a" +testdata-aliases
− docs/LICENSE 
@@ -1,30 +0,0 @@-Copyright Neil Mitchell 2004-2015.-All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are-met:--    * Redistributions of source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.--    * Redistributions in binary form must reproduce the above-      copyright notice, this list of conditions and the following-      disclaimer in the documentation and/or other materials provided-      with the distribution.--    * Neither the name of Neil Mitchell nor the names of other-      contributors may be used to endorse or promote products derived-      from this software without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
hoogle.cabal view
@@ -1,196 +1,147 @@-cabal-version:      >= 1.10+cabal-version:      1.18 build-type:         Simple name:               hoogle-version:            4.2.43+version:            5.0.19.0 license:            BSD3-license-file:       docs/LICENSE+license-file:       LICENSE category:           Development author:             Neil Mitchell <ndmitchell@gmail.com> maintainer:         Neil Mitchell <ndmitchell@gmail.com>-copyright:          Neil Mitchell 2004-2015+copyright:          Neil Mitchell 2004-2026 synopsis:           Haskell API Search description:     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.-homepage:           http://www.haskell.org/hoogle/+homepage:           https://hoogle.haskell.org/ bug-reports:        https://github.com/ndmitchell/hoogle/issues-tested-with:        GHC==7.10.1, GHC==7.8.4, GHC==7.6.3+tested-with:        GHC==9.8, GHC==9.6, GHC==9.4 extra-doc-files:     README.md     CHANGES.txt extra-source-files:-    datadir/*.txt--data-dir: datadir+    cbits/*.h+    cbits/*.c data-files:-    resources/*.css-    resources/*.gif-    resources/*.ico-    resources/*.js-    resources/*.png-    resources/*.html-    resources/search.xml+    misc/sample-data/henry.txt+    misc/sample-data/emily-1.11/emily.txt+    misc/sample-data/emily-1.2/emily.txt+    misc/settings.txt+    html/*.js+    html/*.png+    html/*.css+    html/*.xml+    html/*.html+    html/plugin/*.css+    html/plugin/*.js+    html/plugin/*.png  source-repository head     type:     git     location: https://github.com/ndmitchell/hoogle.git  library-    hs-source-dirs: src-    default-language: Haskell98+    hs-source-dirs:     src+    default-language:   Haskell2010      build-depends:-        base > 4 && < 5,-        array, containers, directory, filepath, process, random,-        safe,+        QuickCheck,+        aeson >= 2,+        ansi-terminal,+        base >= 4 && < 5,+        blaze-html,+        blaze-markup,         binary,-        bytestring >= 0.9,-        conduit >= 0.2,+        bytestring >= 0.10.2.0,+        Cabal-syntax >= 3.8,+        cmdargs,+        conduit >= 1.3.0,+        conduit-extra >= 1.2.3.2,+        containers >= 0.5,+        crypton-connection >= 0.4.1,+        data-default-class,+        deepseq,+        directory,+        extra >= 1.6.6,+        filepath,+        ghc-lib-parser >= 9.6.5 && < 9.16,+        hackage-revdeps >= 0.3 && < 0.4,+        old-locale,+        hashable,+        haskell-src-exts >= 1.22 && < 1.24,+        http-conduit >= 2.3,+        http-types,+        js-flot,+        js-jquery,+        mmap,+        process-extras,         resourcet,-        parsec >= 2.1,-        deepseq >= 1.1,-        text >= 0.11,-        transformers >= 0.2,-        uniplate >= 1.6,-        blaze-builder >= 0.2,-        case-insensitive >= 0.2,-        http-types >= 0.7,-        wai >= 1.1,-        vector >= 0.9,-        vector-algorithms >= 0.6,-        QuickCheck,-        haskell-src-exts >= 1.16 && < 1.18+        safe >= 0.3.20,+        storable-tuple,+        tar,+        template-haskell,+        temporary,+        text >= 2,+        time >= 1.5,+        transformers,+        uniplate,+        utf8-string >= 0.3.1,+        vector,+        wai,+        wai-logger,+        warp,+        warp-tls >= 3.4.2,+        zlib -    if !os(mingw32)-        build-depends: unix+    c-sources:        cbits/text_search.c+    include-dirs:     cbits+    includes:         include.h+    install-includes: include.h+    cc-options:       -std=c99 +    ghc-options:      -fno-state-hack+    if impl(ghc < 8.0)+        build-depends: semigroups >= 0.18+     exposed-modules:         Hoogle -    -- modules that I would conditionally expose, were it not for-    -- http://hackage.haskell.org/trac/hackage/ticket/776     other-modules:-        Hoogle.DataBase.All-        Hoogle.Type.All-        Hoogle.Query.All-        Hoogle.Score.All-        Hoogle.Search.All-        Hoogle.Language.Haskell--    other-modules:-        General.Heap-        General.TypeMap-        General.Base-        General.System-        General.BurrowsWheeler-        General.FMIndex+        Paths_hoogle+        Action.CmdLine+        Action.Generate+        Action.Search+        Action.Server+        Action.Test+        Input.Cabal+        Input.Download+        Input.Haddock+        Input.Item+        Input.ParseDecl+        Input.Reorder+        Input.Set+        Input.Settings+        Output.Items+        Output.Names+        Output.Tags+        Output.Types+        Query+        General.Conduit+        General.IString+        General.Log+        General.Store+        General.Str+        General.Template+        General.Timing         General.Util         General.Web-        Hoogle.DataBase.Aliases-        Hoogle.DataBase.Instances-        Hoogle.DataBase.Items-        Hoogle.DataBase.Serialise-        Hoogle.DataBase.SubstrSearch-        Hoogle.DataBase.Suggest-        Hoogle.DataBase.Type-        Hoogle.DataBase.TypeSearch.Binding-        Hoogle.DataBase.TypeSearch.EntryInfo-        Hoogle.DataBase.TypeSearch.Graph-        Hoogle.DataBase.TypeSearch.Graphs-        Hoogle.DataBase.TypeSearch.Result-        Hoogle.DataBase.TypeSearch.TypeScore-        Hoogle.DataBase.TypeSearch.All-        Hoogle.DataBase2.Str-        Hoogle.DataBase2.Type-        Hoogle.Type.Docs-        Hoogle.Type.Item-        Hoogle.Type.Language-        Hoogle.Type.TagStr-        Hoogle.Type.TypeSig-        Hoogle.Type.ParseError-        Hoogle.Type.Result-        Hoogle.Query.Parser-        Hoogle.Query.Render-        Hoogle.Query.Suggest-        Hoogle.Query.Type-        Hoogle.Score.Scoring-        Hoogle.Score.Type-        Hoogle.Search.Results-        Hoogle.Store.All-        Hoogle.Store.ReadBuffer-        Hoogle.Store.Type-        Hoogle.Store.WriteBuffer-        Paths_hoogle + executable hoogle-    main-is:            Main.hs-    hs-source-dirs:     src-    default-language: Haskell98+    main-is:            src/Main.hs+    default-language:   Haskell2010+    ghc-options:        -threaded -rtsopts      build-depends:-        base > 4 && < 5,-        bytestring, filepath, directory, process, random,-        array, containers, time, old-locale,-        safe,-        binary,-        aeson >= 0.6.1,-        cmdargs >= 0.7,-        deepseq >= 1.1,-        tagsoup >= 0.11,-        blaze-builder >= 0.2,-        http-types >= 0.7,-        case-insensitive >= 0.2,-        text >= 0.11,-        vector >= 0.9,-        vector-algorithms >= 0.6,-        transformers >= 0.2,-        uniplate >= 1.6,-        conduit >= 0.2,-        resourcet,-        parsec >= 2.1,-        wai >= 1.1,-        warp >= 2.1,-        Cabal >= 1.8,-        shake >= 0.14,-        QuickCheck,-        haskell-src-exts >= 1.16 && < 1.18--    if !os(mingw32)-        build-depends: unix--    other-modules:-        CmdLine.All-        CmdLine.Load-        CmdLine.Type-        Console.All-        Console.Log-        Console.Rank-        Console.Search-        Console.Test-        Paths_hoogle-        Recipe.All-        Recipe.Cabal-        Recipe.Command-        Recipe.Hackage-        Recipe.Haddock-        Recipe.Keyword-        Test.All-        Test.BWT_FM-        Test.Docs-        Test.General-        Test.Parse_Query-        Test.Parse_TypeSig-        Web.All-        Web.Page-        Web.Response-        Web.Server-        Web.Template--test-suite hoogle-test-    main-is: Test.hs-    hs-source-dirs: src-    default-language: Haskell98--    type: exitcode-stdio-1.0-    build-depends: base >= 3, process, directory, filepath, temporary >= 1.1+        base >= 4 && < 5,+        hoogle
+ html/favicon.png view

binary file changed (absent → 272 bytes)

+ html/favicon57.png view

binary file changed (absent → 771 bytes)

+ html/favicon64.png view

binary file changed (absent → 813 bytes)

+ html/hoogle.css view
@@ -0,0 +1,383 @@+/********************************************************************+*  GENERAL ELEMENTS+*/++html {+    height: 100%;+}++body {+    margin: 0px;+    padding: 0px;+    font-family: sans-serif;+    font-size: 13px;+    min-height: 100vh;+    display: flex;+    flex-direction: column;+}++#body {+    flex-grow: 1;+    position: relative;+}++a img {+    padding: 0px;+    margin: 0px;+    border: 0px;+}++a:hover {+    background-color: #ffb;+}++a {+    color: #C4451D;+    text-decoration: none;+}++/********************************************************************+*  TOP - LINKS AND SEARCH+*/++#links {+    background: none repeat scroll 0 0 #293845;+    border-top: 5px solid #4E6272;+    color: #DDDDDD;+    text-align: right;+    padding: 0.2em;+}++#top-menu {+    display: inline-table;+    list-style: none outside none;+    margin: 0 0 0 1em;+    text-align: left;+}++#top-menu li {+    border-left: 1px solid #D5D5D5;+    display: inline;+    padding: 0;+    white-space: nowrap;+}++#top-menu li a,+#top-menu li a:link,+#top-menu li a:visited {+    font-size: 85%;+    color: white;+    text-decoration: none;+    padding: 0.2em 0.5em;+}++#top-menu li a:hover {+    background-color: #4e6272;+    text-decoration: underline;+}++form {+    margin-bottom: 0px;+}++#logo img {+    vertical-align: bottom;+}++#hoogle, #scope, #scope_chosen, #submit {+    font-size: 16px;+    margin-bottom: 16px;+    vertical-align: bottom;+}+#scope_chosen, #scope {+    width: 200px;+}+#scope_chosen .chosen-drop {+    width: 400px;+}+.chosen-container .chosen-results li em {+  font-weight: bold;+  text-decoration: none !important;+}++#hoogle {+    width: 300px;+    margin-right: 5px;+    margin-left: 5px;+}++#submit {+    padding-left: 15px;+    padding-right: 15px;+}++#top-menu li#plugin {+    display: none;+    cursor: pointer;+}+++/********************************************************************+*  LEFT - EXTRA SUGGESTIONS+*/++#left {+    float: left;+    width: 140px;+    margin: 0px;+    padding: 0px;+    margin-left: 10px;+    overflow: hidden;+    position: absolute;+    top: 0;+    left: 0;+}++#left li {+    list-style-type: none;+    margin-bottom: 7px;+    white-space: nowrap;+    display: block;+}++#left a {+    color: #C4451D;+    text-decoration: none;+    background-repeat: no-repeat;+}++#left .plus {+    padding-right: 16px;+    background-image: url(more_small.png);+    background-position: center right;+    color: #0E774A;+}++#left .pad {+    padding-left: 16px;+}++#left .minus {+    color: #770E00;+    padding-left: 16px;+    background-image: url(less_small.png);+    background-position: center left;+}+++/********************************************************************+*  BOTTOM - COPYRIGHT MESSAGE+*/++#footer {+    background: none repeat scroll 0 0 #DDDDDD;+    border-top: 1px solid #AAAAAA;+    color: #666666;+    width: 100%;+    padding: 1.3em 0;+    text-align: center;+}+++/********************************************************************+*  HEADING+*/++h1 {+    padding: 5px;+    margin-top: 0px;+    margin-bottom: 0px;+    padding-bottom: 0px;+    font-weight: bold;+    padding-left: 170px;+    font-size: 16px;+}++p {+    margin-left: 170px;+    margin-right: 20px;+    font-size: 16px;+}+++/********************************************************************+*  SPECIAL PAGES+*/++.error {+    border-bottom: 2px solid red;+    text-decoration: none;+    white-space: pre;+}++#example {+    margin: auto;+    margin-top: 20px;+    margin-bottom: 20px;+    padding: 3px;+    width: 400px;+    border: 2px solid #cc0;+    color: black;+    background-color: #F5F5F5;+    border: 1px solid #E5E5E5;+    text-align: left;+}++#example a {+    margin-left: 20px;+}+++/********************************************************************+*  RESULTS+*/++.result {+    margin-left: 170px;+    margin-right: 20px;+    margin-top: 1.5em;+}++.result.active {+    background-color: #f7f5c0;+}++.from, .doc {+    margin-top: 0.4em;+}++a.dull, a.dull:hover {+    text-decoration: none;+}++/** ANSWERS **/++.ans i {+    font-weight: bold;+    font-style: normal;+}++.ans {+    background: none repeat scroll 0 0 #F0F0F0;+    border-top: 1px solid #CCCCCC;+    font-size: 16px;+    padding: 0.2em 0.5em;+}++.ans a {+    color: black;+}+.ans .name {+    color: #C4451D;+}++.links {+    float: right;+    color: #CCCCCC;+}+.links a {+    color: #888;+    font-size: 12px;+}++.c0{background-color: #fcc;}+.c1{background-color: #cfc;}+.c2{background-color: #ccf;}+.c3{background-color: #ffc;}+.c4{background-color: #fcf;}+.c5{background-color: #cff;}++.more, .more:visited {+    padding-left: 16px;+    background-image: url(more_blue.png);+    background-repeat: no-repeat;+    background-position: center left;+    color: blue;+}++/** PARENTS **/++.from a, .p1, .p2 {+    white-space: nowrap;+    text-decoration: none;+    color: #0E774A;+}++/** DOCS **/+/*+docs may be in one of three states:+    .doc - shut and no icon+    .doc.shut - shut with an icon to expand+    .doc.open - open with an icon to collapse+*/++.doc {+    font-size: 11px;+    background-repeat: no-repeat;+    background-position: 2px left;+    margin-bottom: 1.0em;+}+.doc, .doc a {+    color: #888;+}+.doc h1, .doc h2, .doc h3, .doc h4, .doc h5, .doc h6 {+    font-size: 11px;+    display: inline;+    padding: 0px;+}++.open, .shut {padding-left: 13px;}+.open {background-image: url(less_gray.png);}+.shut {background-image: url(more_gray.png);}++.doc, .shut {+    max-height: 2.0em;+    overflow: hidden;+}+.open {+    max-height: 100%;+    white-space: pre-wrap;+}+++/********************************************************************+*  PHONE SPECIFIC+*/++.phone #links {+    float: none;+    margin-left: 5px;+}++.phone #search {+    text-align: center;+}++.phone #submit {+    display: none;+}++.phone #left {+    display: none;+}++.phone h1 {+    padding-left: 5px;+}++.phone p {+    margin-left: 5px+}++.phone #example {+    width: auto;+}++.phone #footer {+    font-size: small;+}++.phone .result {+    margin-left: 5px;+    margin-right: 5px;+}
+ html/hoogle.js view
@@ -0,0 +1,417 @@++// PERHAPS I SHOULD BE USING Bootstrap with:+// http://silviomoreto.github.io/bootstrap-select/+++var embed = false; // are we running as an embedded search box+var instant = true; // should we search on key presses+var query = parseQuery(); // what is the current query string++var $hoogle; // $("#hoogle") after load+++/////////////////////////////////////////////////////////////////////+// SEARCHING++function on_arrow_press(ev) {+    var offset = 0;+    if (ev.keyCode == Key.Up) {+        offset = -1;+    } else if (ev.keyCode == Key.Down) {+        offset = +1;+    } else if (ev.keyCode != Key.Return) {+        return;+    }++    // Figure out where we are+    var results = $("div#body .result");+    var activeResults = $("div#body .result.active");+    var activeRow = -1;+    if (activeResults.length == 1) {+        activeRow = results.index(activeResults[0]);+    }++    if (ev.keyCode == Key.Return) {+        if (activeRow >= 0)+            document.location.href = $("a", activeResults).attr("href");+    } else {+        var newRow = activeRow + offset;+        var $activeRow = $(results[activeRow]);+        if (newRow < 0) {+            $activeRow.removeClass("active");+            $hoogle.focus();+        } else if (newRow < results.length) {+            var $newRow = $(results[newRow]);+            if (activeRow >= 0)+                $activeRow.removeClass("active");+            $newRow.addClass("active");+            $hoogle.blur();+        }+    }+}++$(function() {+    $(document).keyup(on_arrow_press);+});++$(function(){+    $hoogle = $("#hoogle");+    var $form = $hoogle.parents("form:first");+    var $scope = $form.find("[name=scope]");+    embed = !$hoogle.hasClass("HOOGLE_REAL");+    if (!embed) $scope.chosen({"search_contains":true});++    var self = embed ? newEmbed() : newReal();++    var ajaxUrl = !embed ? "?" : $form.attr("action") + "?";+    var ajaxMode = embed ? 'embed' : 'body';++    var active = $hoogle.val() + " " + $scope.val(); // What is currently being searched for (may not yet be displayed)+    var past = cache(100); // Cache of previous searches+    var watch = watchdog(500, function(){self.showWaiting();}); // Timeout of the "Waiting..." callback++    function hit(){+        if (!instant) return;+        function getScope(){+            var v = $scope ? $scope.val() : "";+            return v == null || v == "set:stackage" ? "" : v;+        }++        var nowHoogle = $hoogle.val();+        var nowScope = getScope();+        var now = nowHoogle + " " + nowScope;+        if (now == active) return;+        active = now;++        var title = now + (now == " " ? "" : " - ") + "Hoogle";+        query["hoogle"] = nowHoogle;+        query["scope"] = nowScope;+        if (!embed){+            if (window.history)+                window.history.replaceState(null, title, renderQuery(query));+            $("title").text(title);+        }++        var old = past.ask(now);+        if (old != undefined){self.showResult(old); return;}++        watch.stop();+        if (embed && now == ""){self.hide(); return;}+        watch.start();++        var data = {hoogle:nowHoogle, scope:nowScope, mode:ajaxMode};+        function complete(e)+        {+            watch.stop();+            var current = $hoogle.val() + " " + getScope() == now;+            if (e.status == 200)+            {+                past.add(now,e.responseText);+                if (current)+                    self.showResult(e.responseText);+            }+            else if (current)+                self.showError(e.status, e.responseText);+        }++        var args = {url:ajaxUrl, data:data, complete:complete, dataType:"html"}+        try {+            $.ajax(args);+        } catch (err) {+            try {+                if (!embed) throw err;+                $.ajaxCrossDomain(args);+            } catch (err) {+                // Probably a permissions error from cross domain scripting...+                watch.stop();+            }+        }+    };+    $hoogle.keyup(hit);+    $scope.change(hit);+})++function newReal()+{+    $hoogle.select();+    var $body = $("#body");++    return {+        showWaiting: function(){$("h1").text("Still working...");},+        showError: function(status,text){$body.html("<h1><b>Error:</b> status " + status + "</h1><p>" + text + "</p>")},+        showResult: function(text){$body.html(text); newDocs();}+    }+}++function newEmbed()+{+    $hoogle.attr("autocomplete","off");+    // IE note: unless the div in the iframe contain any border it doesn't calculate the correct outerHeight()+    //          therefore we put 3 borders on the iframe, and leave one for the bottom div+    var $iframe = $("<iframe id='hoogle-output' scrolling='no' "++                    "style='position:absolute;border:1px solid rgb(127,157,185);border-bottom:0px;display:none;' />");+    var $body;+    $iframe.load(function(){+        var $contents = $iframe.contents();+        $contents.find("head").html(+            "<style type='text/css'>" ++            "html {border: 0px;}" ++            "body {font-family: sans-serif; font-size: 13px; background-color: white; padding: 0px; margin: 0px;}" ++            "a, i {display: block; color: black; padding: 1px 3px; text-decoration: none; white-space: nowrap; overflow: hidden; cursor: default;}" ++            "a.sel {background-color: rgb(10,36,106); color: white;}" ++            "div {border-bottom:1px solid rgb(127,157,185);}" ++            "</style>");+        $body = $("<div>").appendTo($contents.find("body"));+    });+    $iframe.insertBefore($hoogle);++    var finishOnBlur = true; // Should a blur hide the box++    function show(x){+        if (x == undefined)+            $iframe.css("display","none");+        else {+            $body.html(x).find("a").attr("target","_parent")+                .mousedown(function(){finishOnBlur = false;})+                .mouseup(function(){finishOnBlur = true;})+                .mouseenter(function(){+                    $body.find(".sel").removeClass("sel");+                    $(this).addClass("sel");+                });++            var pos = $hoogle.position();+            // need to display before using $body.outerHeight() on Firefox+            $iframe.css("display","").css(+                {top:px(pos.top + $hoogle.outerHeight() + unpx($hoogle.css("margin-top")))+                ,left:px(pos.left + unpx($hoogle.css("margin-left")))+                ,width:px($hoogle.outerWidth() - 2 /* iframe border */)+                ,height:$body.outerHeight()+                });+        }+    }++    $hoogle.blur(function(){if (finishOnBlur) show();});++    $hoogle.keydown(function(event){+        switch(event.which)+        {+        case Key.Return:+            var sel = $body.find(".sel:first");+            if (sel.size() == 0) return;+            event.preventDefault();+            document.location.href = sel.attr("href");+            break;++        case Key.Escape:+            $body.find(".sel").removeClass("sel");+            show();+            break;++        case Key.Down: case Key.Up:+            var i = event.which == Key.Down ? 1 : -1;+            var all = $body.find("a");+            var sel = all.filter(".sel");+            var now = all.index(sel);+            if (now == -1)+                all.filter(i == 1 ? ":first" : ":last").addClass("sel");+            else {+                sel.removeClass("sel");+                // IE treats :eq(-1) as :eq(0), so filter specifically+                if (now+i >= 0) all.filter(":eq(" + (now+i) + ")").addClass("sel");+            }+            event.preventDefault();+            break;+        }+    });++    return {+        showWaiting: function(){show("<i>Still working...</i>");},+        showError: function(status,text){show("<i>Error: status " + status + "</i>");},+        showResult: function(text){show(text);},+        hide: function(){show();}+    }+}+++/////////////////////////////////////////////////////////////////////+// SEARCH PLUGIN++var prefixUrl = document.location.protocol + "//" + document.location.hostname + document.location.pathname;++$(function(){+    if (embed) return;+    if (prefixUrl != "http://hoogle.haskell.org/")+    {+        $("link[rel=search]").attr("href", function(){+            return this.href + "?domain=" + escape(prefixUrl);+        });+    }+    if (window.external && ("AddSearchProvider" in window.external))+    {+        $("#plugin").css("display","inline").on('click', function(){+            var url = $("link[rel=search]").attr("href");+            //  If neither scheme(http(s)://) nor DSN prefix(//) is in URL then we+            //  should add prefix.+            if (url.indexOf('://') === -1 && url.indexOf('//') !== 0)+                url = prefixUrl + url;+            window.external.AddSearchProvider(url);+        });+    }+});+++/////////////////////////////////////////////////////////////////////+// DOCUMENTATION++$(function(){+    if (embed) return;+    $(window).resize(resizeDocs);+    newDocs();+});++function resizeDocs()+{+    $("#body .doc").each(function(){+        // If a segment is open, it should remain open forever+        var $this = $(this);+        var toosmall = ($.support.preWrap && $this.hasClass("newline")) ||+                       ($this.height() < $this.children().height());+        if (toosmall && !$this.hasClass("open"))+            $this.addClass("shut");+        else if (!toosmall && $this.hasClass("shut"))+            $this.removeClass("shut");+    });+}++function newDocs()+{+    resizeDocs();+    $("#body .doc").click(function(){+        var $this = $(this);+        if ($this.hasClass("open") || $this.hasClass("shut"))+            $this.toggleClass("open").toggleClass("shut");+    });+}+++/////////////////////////////////////////////////////////////////////+// iOS TWEAKS++$(function(){+    if ($.support.inputSearch)+        $("#hoogle")[0].type = "search";++    var qphone = query["phone"];+    phone =+        qphone == "0" ? false :+        qphone == "1" ? true :+        $.support.phone;++    if (!phone) return;+    $("body").addClass("phone");+    $("head").append("<meta name='viewport' content='width=device-width' />");+});+++/////////////////////////////////////////////////////////////////////+// LIBRARY BITS++function parseQuery() // :: IO (Dict String String)+{+    // From http://stackoverflow.com/questions/901115/get-querystring-values-with-jquery/3867610#3867610+    var params = {},+        e,+        a = /\+/g,  // Regex for replacing addition symbol with a space+        r = /([^&=]+)=?([^&]*)/g,+        d = function (s) { return decodeURIComponent(s.replace(a, " ")); },+        q = window.location.search.substring(1);++    while (e = r.exec(q))+        params[d(e[1])] = d(e[2]);++    return params;+}++function renderQuery(query) // Dict String String -> IO String+{+    var s = "";+    for (var i in query)+    {+        if (query[i] != "")+            s += (s == "" ? "?" : "&") + i + "=" + encodeURIComponent(query[i]);+    }+    return window.location.href.substring(0, window.location.href.length - window.location.search.length) + s;+}+++// Supports white-space: pre-wrap;+$.support.preWrap = true;++$.support.iOS =+    (navigator.userAgent.indexOf("iPhone") != -1) ||+    (navigator.userAgent.indexOf("iPod") != -1) ||+    (navigator.userAgent.indexOf("iPad") != -1);++$.support.phone =+    (navigator.userAgent.indexOf("iPhone") != -1) ||+    (navigator.userAgent.indexOf("iPod") != -1) ||+    (navigator.userAgent.indexOf("Android") != -1);++// Supports <input type=search />+$.support.inputSearch = $.support.iOS;++var Key = {+    Up: 38,+    Down: 40,+    Return: 13,+    Escape: 27+};++function unpx(x){var r = 1 * x.replace("px",""); return isNaN(r) ? 0 : r;}+function px(x){return x + "px";}++function cache(maxElems)+{+    // FIXME: Currently does not evict things+    var contents = {}; // what we have in the cache, with # prepended+    // note that contents[toString] != undefined, since it's a default method+    // hence the leading #++    return {+        add: function(key,val)+        {+            contents["#" + key] = val;+        },++        ask: function(key)+        {+            return contents["#" + key];+        }+    };+}++function watchdog(time, fun)+{+    var id = undefined;+    function stop(){if (id == undefined) return; window.clearTimeout(id); id = undefined;}+    function start(){stop(); id = window.setTimeout(function(){id = undefined; fun();}, time);}+    return {start:start, stop:stop}+}++$.ajaxCrossDomain = function(args)+{+    if (!window.XDomainRequest) throw new Error("the XDomainRequest object is not supported in this browser");++    var xdr = new XDomainRequest();+    xdr.onload = function(){args.complete({status:200, responseText:xdr.responseText});};+    xdr.onerror = function(){args.complete({status:0, responseText:""});};++    var url = "";+    for (var i in args.data)+    {+        if (args.data[i] == undefined) continue;+        url += (url == "" ? "" : "&") + encodeURIComponent(i) + "=" + encodeURIComponent(args.data[i]);+    }+    xdr.open("get", args.url + url);+    xdr.send();+}
+ html/hoogle.png view

binary file changed (absent → 1962 bytes)

+ html/index.html view
@@ -0,0 +1,38 @@+<!DOCTYPE HTML>+<html>+    <head profile="http://a9.com/-/spec/opensearch/1.1/">+        <meta http-equiv="Content-Type" content="text/html; charset=utf8" />+        <title>#{title}</title>+        <meta name="robots" content="#{robots}" />+        <link type="text/css" rel="stylesheet" href="#{cdn}hoogle.css" />+        <link rel="stylesheet" type="text/css" href="#{cdn}plugin/chosen.css" />+        <link type="image/png" rel="icon" href="#{cdn}favicon.png" />+        <link type="image/png" rel="apple-touch-icon" href="#{cdn}favicon57.png" />+        <link type="application/opensearchdescription+xml" rel="search" href="#{cdn}search.xml" title="Hoogle" />+        <script type="text/javascript" src="#{jquery}"> </script>+        <script type="text/javascript" src="#{cdn}plugin/jquery-cookie.js"> </script>+        <script type="text/javascript" src="#{cdn}plugin/chosen-jquery.js"> </script>+        <script type="text/javascript" src="#{cdn}hoogle.js"> </script>+    </head>+    <body>+<div id="links">+    <ul id="top-menu">+        <li id="plugin"><a>Search plugin</a></li>+        <li><a href="https://github.com/ndmitchell/hoogle/blob/master/README.md">Manual</a></li>+        <li><a href="https://www.haskell.org">haskell.org</a></li>+    </ul>+</div>+<form action="" method="get" id="search">+    <a id="logo" href="#{home}">+        <img src="#{cdn}hoogle.png" width="160" height="58" alt="Hoogle"+    /></a>+    <input name="hoogle" id="hoogle" class="HOOGLE_REAL" type="text" autocomplete="off" autofocus="autofocus" accesskey="1" placeholder="Search for..." value="#{search}" />+    <select name="scope" id="scope" data-live-search="true">#{tags}</select>+    <input id="submit" type="submit" value="Search" />+</form>+<div id="body">+#{body}+        </div>+        <div id="footer">&copy; <a href="http://ndmitchell.com">Neil Mitchell</a> 2004-2024, version #{version}</div>+    </body>+</html>
+ html/less_blue.png view

binary file changed (absent → 212 bytes)

+ html/less_gray.png view

binary file changed (absent → 123 bytes)

+ html/less_small.png view

binary file changed (absent → 148 bytes)

+ html/log.html view
@@ -0,0 +1,29 @@+<!DOCTYPE HTML>+<html>+    <head>+        <meta http-equiv="Content-Type" content="text/html; charset=utf8" />+        <title>Log view</title>+        <link type="text/css" rel="stylesheet" href="#{cdn}hoogle.css" />+        <link type="image/png" rel="icon" href="#{cdn}favicon.png" />+        <script type="text/javascript" src="#{jquery}"> </script>+        <script type="text/javascript" src="log.js"> </script>+        <script type="text/javascript" src="plugin/jquery.flot.js"> </script>+        <script type="text/javascript" src="plugin/jquery.flot.time.js"> </script>++<style type="text/css">+.plot {width: 90%; max-width: 600px; height: 200px;}+</style>++    </head>+    <body>+</head>+<body style="height:100%;width:100%;">+<h2>Hoogle Log</h2>+<b>Users</b><div id="users" class="plot"></div><br/>+<b>Timings</b><div id="timings" class="plot"></div><br/>+<b>Errors</b><div id="errors" class="plot"></div><br/>++<div id="tooltip" style="position:absolute;display:none;border-radius:4px;border:1px solid gray;padding:3px;background-color:#fea;box-shadow: 4px 3px 8px -1px rgba(0,0,0,0.38);"></div>++</body>+</html>
+ html/log.js view
@@ -0,0 +1,38 @@+var data = #{data};+function series(name, val)+{+    val.label = name;+    val.data = [];+    for (var i = 0; i < data.length; i++)+    {+        var x = data[i][name.toLowerCase()];+        val.data.push([new Date(data[i].date),x == 0 ? null : x]);+    }+    return val;+}+$(function(){+    var settings =+        {series: {lines: {show: true}, points: {show: true}}+        ,xaxis: {mode: "time", minTickSize: [1, "day"]}+        ,yaxes: [{}, {position: "right"}]+        ,grid: {hoverable: true, clickable: true}};+    $.plot("#users",[series("Uses",{yaxis:2}),series("Users",{})], settings);+    $.plot("#timings",[series("Average",{}),series("Slowest",{yaxis:2})], settings);+    settings.series.lines.show = false;+    $.plot("#errors",[series("Errors",{color:"darkred"})], settings);++    $(".plot").bind("plothover", function (event, pos, item) {+        if (item) {+            var x = new Date(item.datapoint[0]).toDateString();+            var y = item.datapoint[1];+            y = Math.floor(y) == y ? y : y.toFixed(3);++            $("#tooltip").html(y + " = " + item.series.label + " on " + x)+                .css({top: item.pageY+5, left: item.pageX+5})+                .fadeIn(200);+        } else {+            $("#tooltip").hide();+        }+    });++});
+ html/more_blue.png view

binary file changed (absent → 204 bytes)

+ html/more_gray.png view

binary file changed (absent → 128 bytes)

+ html/more_small.png view

binary file changed (absent → 149 bytes)

+ html/plugin/chosen-jquery.js view
@@ -0,0 +1,1271 @@+/*!+Chosen, a Select Box Enhancer for jQuery and Prototype+by Patrick Filler for Harvest, http://getharvest.com++Version 1.3.0+Full source at https://github.com/harvesthq/chosen+Copyright (c) 2011-2014 Harvest http://getharvest.com++MIT License, https://github.com/harvesthq/chosen/blob/master/LICENSE.md+This file is generated by `grunt build`, do not edit it by hand.+*/++(function() {+  var $, AbstractChosen, Chosen, SelectParser, _ref,+    __hasProp = {}.hasOwnProperty,+    __extends = function(child, parent) { for (var key in parent) { if (__hasProp.call(parent, key)) child[key] = parent[key]; } function ctor() { this.constructor = child; } ctor.prototype = parent.prototype; child.prototype = new ctor(); child.__super__ = parent.prototype; return child; };++  SelectParser = (function() {+    function SelectParser() {+      this.options_index = 0;+      this.parsed = [];+    }++    SelectParser.prototype.add_node = function(child) {+      if (child.nodeName.toUpperCase() === "OPTGROUP") {+        return this.add_group(child);+      } else {+        return this.add_option(child);+      }+    };++    SelectParser.prototype.add_group = function(group) {+      var group_position, option, _i, _len, _ref, _results;+      group_position = this.parsed.length;+      this.parsed.push({+        array_index: group_position,+        group: true,+        label: this.escapeExpression(group.label),+        children: 0,+        disabled: group.disabled,+        classes: group.className+      });+      _ref = group.childNodes;+      _results = [];+      for (_i = 0, _len = _ref.length; _i < _len; _i++) {+        option = _ref[_i];+        _results.push(this.add_option(option, group_position, group.disabled));+      }+      return _results;+    };++    SelectParser.prototype.add_option = function(option, group_position, group_disabled) {+      if (option.nodeName.toUpperCase() === "OPTION") {+        if (option.text !== "") {+          if (group_position != null) {+            this.parsed[group_position].children += 1;+          }+          this.parsed.push({+            array_index: this.parsed.length,+            options_index: this.options_index,+            value: option.value,+            text: option.text,+            html: option.innerHTML,+            selected: option.selected,+            disabled: group_disabled === true ? group_disabled : option.disabled,+            group_array_index: group_position,+            classes: option.className,+            style: option.style.cssText+          });+        } else {+          this.parsed.push({+            array_index: this.parsed.length,+            options_index: this.options_index,+            empty: true+          });+        }+        return this.options_index += 1;+      }+    };++    SelectParser.prototype.escapeExpression = function(text) {+      var map, unsafe_chars;+      if ((text == null) || text === false) {+        return "";+      }+      if (!/[\&\<\>\"\'\`]/.test(text)) {+        return text;+      }+      map = {+        "<": "&lt;",+        ">": "&gt;",+        '"': "&quot;",+        "'": "&#x27;",+        "`": "&#x60;"+      };+      unsafe_chars = /&(?!\w+;)|[\<\>\"\'\`]/g;+      return text.replace(unsafe_chars, function(chr) {+        return map[chr] || "&amp;";+      });+    };++    return SelectParser;++  })();++  SelectParser.select_to_array = function(select) {+    var child, parser, _i, _len, _ref;+    parser = new SelectParser();+    _ref = select.childNodes;+    for (_i = 0, _len = _ref.length; _i < _len; _i++) {+      child = _ref[_i];+      parser.add_node(child);+    }+    return parser.parsed;+  };++  AbstractChosen = (function() {+    function AbstractChosen(form_field, options) {+      this.form_field = form_field;+      this.options = options != null ? options : {};+      if (!AbstractChosen.browser_is_supported()) {+        return;+      }+      this.is_multiple = this.form_field.multiple;+      this.set_default_text();+      this.set_default_values();+      this.setup();+      this.set_up_html();+      this.register_observers();+      this.on_ready();+    }++    AbstractChosen.prototype.set_default_values = function() {+      var _this = this;+      this.click_test_action = function(evt) {+        return _this.test_active_click(evt);+      };+      this.activate_action = function(evt) {+        return _this.activate_field(evt);+      };+      this.active_field = false;+      this.mouse_on_container = false;+      this.results_showing = false;+      this.result_highlighted = null;+      this.allow_single_deselect = (this.options.allow_single_deselect != null) && (this.form_field.options[0] != null) && this.form_field.options[0].text === "" ? this.options.allow_single_deselect : false;+      this.disable_search_threshold = this.options.disable_search_threshold || 0;+      this.disable_search = this.options.disable_search || false;+      this.enable_split_word_search = this.options.enable_split_word_search != null ? this.options.enable_split_word_search : true;+      this.group_search = this.options.group_search != null ? this.options.group_search : true;+      this.search_contains = this.options.search_contains || false;+      this.single_backstroke_delete = this.options.single_backstroke_delete != null ? this.options.single_backstroke_delete : true;+      this.max_selected_options = this.options.max_selected_options || Infinity;+      this.inherit_select_classes = this.options.inherit_select_classes || false;+      this.display_selected_options = this.options.display_selected_options != null ? this.options.display_selected_options : true;+      return this.display_disabled_options = this.options.display_disabled_options != null ? this.options.display_disabled_options : true;+    };++    AbstractChosen.prototype.set_default_text = function() {+      if (this.form_field.getAttribute("data-placeholder")) {+        this.default_text = this.form_field.getAttribute("data-placeholder");+      } else if (this.is_multiple) {+        this.default_text = this.options.placeholder_text_multiple || this.options.placeholder_text || AbstractChosen.default_multiple_text;+      } else {+        this.default_text = this.options.placeholder_text_single || this.options.placeholder_text || AbstractChosen.default_single_text;+      }+      return this.results_none_found = this.form_field.getAttribute("data-no_results_text") || this.options.no_results_text || AbstractChosen.default_no_result_text;+    };++    AbstractChosen.prototype.mouse_enter = function() {+      return this.mouse_on_container = true;+    };++    AbstractChosen.prototype.mouse_leave = function() {+      return this.mouse_on_container = false;+    };++    AbstractChosen.prototype.input_focus = function(evt) {+      var _this = this;+      if (this.is_multiple) {+        if (!this.active_field) {+          return setTimeout((function() {+            return _this.container_mousedown();+          }), 50);+        }+      } else {+        if (!this.active_field) {+          return this.activate_field();+        }+      }+    };++    AbstractChosen.prototype.input_blur = function(evt) {+      var _this = this;+      if (!this.mouse_on_container) {+        this.active_field = false;+        return setTimeout((function() {+          return _this.blur_test();+        }), 100);+      }+    };++    AbstractChosen.prototype.results_option_build = function(options) {+      var content, data, _i, _len, _ref;+      content = '';+      _ref = this.results_data;+      for (_i = 0, _len = _ref.length; _i < _len; _i++) {+        data = _ref[_i];+        if (data.group) {+          content += this.result_add_group(data);+        } else {+          content += this.result_add_option(data);+        }+        if (options != null ? options.first : void 0) {+          if (data.selected && this.is_multiple) {+            this.choice_build(data);+          } else if (data.selected && !this.is_multiple) {+            this.single_set_selected_text(data.text);+          }+        }+      }+      return content;+    };++    AbstractChosen.prototype.result_add_option = function(option) {+      var classes, option_el;+      if (!option.search_match) {+        return '';+      }+      if (!this.include_option_in_results(option)) {+        return '';+      }+      classes = [];+      if (!option.disabled && !(option.selected && this.is_multiple)) {+        classes.push("active-result");+      }+      if (option.disabled && !(option.selected && this.is_multiple)) {+        classes.push("disabled-result");+      }+      if (option.selected) {+        classes.push("result-selected");+      }+      if (option.group_array_index != null) {+        classes.push("group-option");+      }+      if (option.classes !== "") {+        classes.push(option.classes);+      }+      option_el = document.createElement("li");+      option_el.className = classes.join(" ");+      option_el.style.cssText = option.style;+      option_el.setAttribute("data-option-array-index", option.array_index);+      option_el.innerHTML = option.search_text;+      return this.outerHTML(option_el);+    };++    AbstractChosen.prototype.result_add_group = function(group) {+      var classes, group_el;+      if (!(group.search_match || group.group_match)) {+        return '';+      }+      if (!(group.active_options > 0)) {+        return '';+      }+      classes = [];+      classes.push("group-result");+      if (group.classes) {+        classes.push(group.classes);+      }+      group_el = document.createElement("li");+      group_el.className = classes.join(" ");+      group_el.innerHTML = group.search_text;+      return this.outerHTML(group_el);+    };++    AbstractChosen.prototype.results_update_field = function() {+      this.set_default_text();+      if (!this.is_multiple) {+        this.results_reset_cleanup();+      }+      this.result_clear_highlight();+      this.results_build();+      if (this.results_showing) {+        return this.winnow_results();+      }+    };++    AbstractChosen.prototype.reset_single_select_options = function() {+      var result, _i, _len, _ref, _results;+      _ref = this.results_data;+      _results = [];+      for (_i = 0, _len = _ref.length; _i < _len; _i++) {+        result = _ref[_i];+        if (result.selected) {+          _results.push(result.selected = false);+        } else {+          _results.push(void 0);+        }+      }+      return _results;+    };++    AbstractChosen.prototype.results_toggle = function() {+      if (this.results_showing) {+        return this.results_hide();+      } else {+        return this.results_show();+      }+    };++    AbstractChosen.prototype.results_search = function(evt) {+      if (this.results_showing) {+        return this.winnow_results();+      } else {+        return this.results_show();+      }+    };++    AbstractChosen.prototype.winnow_results = function() {+      var escapedSearchText, option, regex, results, results_group, searchText, startpos, text, zregex, _i, _len, _ref;+      this.no_results_clear();+      results = 0;+      searchText = this.get_search_text();+      escapedSearchText = searchText.replace(/[-[\]{}()*+?.,\\^$|#\s]/g, "\\$&");++      ///////////////////////////////////////////////////////////////+      // CHANGED+      // zregex = new RegExp(escapedSearchText, 'i');+      // regex = this.get_search_regex(escapedSearchText);+      var $$regexs = [];+      var $$list = escapedSearchText.split("\\ ");+      for (var $$i = 0; $$i < $$list.length; $$i++)+        $$regexs.push(new RegExp($$list[$$i],'i'));+      ///////////////////////////////////////////////////////////////++      _ref = this.results_data;+      for (_i = 0, _len = _ref.length; _i < _len; _i++) {+        option = _ref[_i];+        option.search_match = false;+        results_group = null;+        if (this.include_option_in_results(option)) {+          if (option.group) {+            option.group_match = false;+            option.active_options = 0;+          }+          if ((option.group_array_index != null) && this.results_data[option.group_array_index]) {+            results_group = this.results_data[option.group_array_index];+            if (results_group.active_options === 0 && results_group.search_match) {+              results += 1;+            }+            results_group.active_options += 1;+          }+          if (!(option.group && !this.group_search)) {+            option.search_text = option.group ? option.label : option.text;++            /////////////////////////////////////////////////////////+            // CHANGED+            // option.search_match = this.search_string_match(option.search_text, regex);+            option.search_match = true;+            for (var $$i = 0; $$i < $$regexs.length; $$i++)+              option.search_match = option.search_match && $$regexs[$$i].test(option.search_text);+            /////////////////////////////////////////////////////////++            if (option.search_match && !option.group) {+              results += 1;+            }+            if (option.search_match) {+              if (searchText.length) {++                /////////////////////////////////////////////////////+                // CHANGED+                // startpos = option.search_text.search(zregex);+                // text = option.search_text.substr(0, startpos + searchText.length) + '</em>' + option.search_text.substr(startpos + searchText.length);+                // option.search_text = text.substr(0, startpos) + '<em>' + text.substr(startpos);+                var $$done = "";+                var $$todo = option.search_text;+                var $$zregex = new RegExp($$list.join("|"), "i");+                while ($$todo != "") {+                  var $$i = $$zregex.exec($$todo);+                  if ($$i == null) {$$done = $$done + $$todo; $$todo = ""; break;}+                  $$done = $$done + $$todo.substr(0, $$i.index) + "<em>" + $$todo.substr($$i.index, $$i[0].length) + "</em>";+                  $$todo = $$todo.substr($$i.index + $$i[0].length);+                }+                option.search_text = $$done;+                /////////////////////////////////////////////////////++              }+              if (results_group != null) {+                results_group.group_match = true;+              }+            } else if ((option.group_array_index != null) && this.results_data[option.group_array_index].search_match) {+              option.search_match = true;+            }+          }+        }+      }+      this.result_clear_highlight();+      if (results < 1 && searchText.length) {+        this.update_results_content("");+        return this.no_results(searchText);+      } else {+        this.update_results_content(this.results_option_build());+        return this.winnow_results_set_highlight();+      }+    };++    AbstractChosen.prototype.get_search_regex = function(escaped_search_string) {+      var regex_anchor;+      regex_anchor = this.search_contains ? "" : "^";+      return new RegExp(regex_anchor + escaped_search_string, 'i');+    };++    AbstractChosen.prototype.search_string_match = function(search_string, regex) {+      var part, parts, _i, _len;+      if (regex.test(search_string)) {+        return true;+      } else if (this.enable_split_word_search && (search_string.indexOf(" ") >= 0 || search_string.indexOf("[") === 0)) {+        parts = search_string.replace(/\[|\]/g, "").split(" ");+        if (parts.length) {+          for (_i = 0, _len = parts.length; _i < _len; _i++) {+            part = parts[_i];+            if (regex.test(part)) {+              return true;+            }+          }+        }+      }+    };++    AbstractChosen.prototype.choices_count = function() {+      var option, _i, _len, _ref;+      if (this.selected_option_count != null) {+        return this.selected_option_count;+      }+      this.selected_option_count = 0;+      _ref = this.form_field.options;+      for (_i = 0, _len = _ref.length; _i < _len; _i++) {+        option = _ref[_i];+        if (option.selected) {+          this.selected_option_count += 1;+        }+      }+      return this.selected_option_count;+    };++    AbstractChosen.prototype.choices_click = function(evt) {+      evt.preventDefault();+      if (!(this.results_showing || this.is_disabled)) {+        return this.results_show();+      }+    };++    AbstractChosen.prototype.keyup_checker = function(evt) {+      var stroke, _ref;+      stroke = (_ref = evt.which) != null ? _ref : evt.keyCode;+      this.search_field_scale();+      switch (stroke) {+        case 8:+          if (this.is_multiple && this.backstroke_length < 1 && this.choices_count() > 0) {+            return this.keydown_backstroke();+          } else if (!this.pending_backstroke) {+            this.result_clear_highlight();+            return this.results_search();+          }+          break;+        case 13:+          evt.preventDefault();+          if (this.results_showing) {+            return this.result_select(evt);+          }+          break;+        case 27:+          if (this.results_showing) {+            this.results_hide();+          }+          return true;+        case 9:+        case 38:+        case 40:+        case 16:+        case 91:+        case 17:+          break;+        default:+          return this.results_search();+      }+    };++    AbstractChosen.prototype.clipboard_event_checker = function(evt) {+      var _this = this;+      return setTimeout((function() {+        return _this.results_search();+      }), 50);+    };++    AbstractChosen.prototype.container_width = function() {+      if (this.options.width != null) {+        return this.options.width;+      } else {+        return "" + this.form_field.offsetWidth + "px";+      }+    };++    AbstractChosen.prototype.include_option_in_results = function(option) {+      if (this.is_multiple && (!this.display_selected_options && option.selected)) {+        return false;+      }+      if (!this.display_disabled_options && option.disabled) {+        return false;+      }+      if (option.empty) {+        return false;+      }+      return true;+    };++    AbstractChosen.prototype.search_results_touchstart = function(evt) {+      this.touch_started = true;+      return this.search_results_mouseover(evt);+    };++    AbstractChosen.prototype.search_results_touchmove = function(evt) {+      this.touch_started = false;+      return this.search_results_mouseout(evt);+    };++    AbstractChosen.prototype.search_results_touchend = function(evt) {+      if (this.touch_started) {+        return this.search_results_mouseup(evt);+      }+    };++    AbstractChosen.prototype.outerHTML = function(element) {+      var tmp;+      if (element.outerHTML) {+        return element.outerHTML;+      }+      tmp = document.createElement("div");+      tmp.appendChild(element);+      return tmp.innerHTML;+    };++    AbstractChosen.browser_is_supported = function() {+      if (window.navigator.appName === "Microsoft Internet Explorer") {+        return document.documentMode >= 8;+      }+      if (/iP(od|hone)/i.test(window.navigator.userAgent)) {+        return false;+      }+      if (/Android/i.test(window.navigator.userAgent)) {+        if (/Mobile/i.test(window.navigator.userAgent)) {+          return false;+        }+      }+      return true;+    };++    AbstractChosen.default_multiple_text = "Select Some Options";++    AbstractChosen.default_single_text = "Select an Option";++    AbstractChosen.default_no_result_text = "No results match";++    return AbstractChosen;++  })();++  $ = jQuery;++  $.fn.extend({+    chosen: function(options) {+      if (!AbstractChosen.browser_is_supported()) {+        return this;+      }+      return this.each(function(input_field) {+        var $this, chosen;+        $this = $(this);+        chosen = $this.data('chosen');+        if (options === 'destroy' && chosen instanceof Chosen) {+          chosen.destroy();+        } else if (!(chosen instanceof Chosen)) {+          $this.data('chosen', new Chosen(this, options));+        }+      });+    }+  });++  Chosen = (function(_super) {+    __extends(Chosen, _super);++    function Chosen() {+      _ref = Chosen.__super__.constructor.apply(this, arguments);+      return _ref;+    }++    Chosen.prototype.setup = function() {+      this.form_field_jq = $(this.form_field);+      this.current_selectedIndex = this.form_field.selectedIndex;+      return this.is_rtl = this.form_field_jq.hasClass("chosen-rtl");+    };++    Chosen.prototype.set_up_html = function() {+      var container_classes, container_props;+      container_classes = ["chosen-container"];+      container_classes.push("chosen-container-" + (this.is_multiple ? "multi" : "single"));+      if (this.inherit_select_classes && this.form_field.className) {+        container_classes.push(this.form_field.className);+      }+      if (this.is_rtl) {+        container_classes.push("chosen-rtl");+      }+      container_props = {+        'class': container_classes.join(' '),+        'style': "width: " + (this.container_width()) + ";",+        'title': this.form_field.title+      };+      if (this.form_field.id.length) {+        container_props.id = this.form_field.id.replace(/[^\w]/g, '_') + "_chosen";+      }+      this.container = $("<div />", container_props);+      if (this.is_multiple) {+        this.container.html('<ul class="chosen-choices"><li class="search-field"><input type="text" value="' + this.default_text + '" class="default" autocomplete="off" style="width:25px;" /></li></ul><div class="chosen-drop"><ul class="chosen-results"></ul></div>');+      } else {+        this.container.html('<a class="chosen-single chosen-default" tabindex="-1"><span>' + this.default_text + '</span><div><b></b></div></a><div class="chosen-drop"><div class="chosen-search"><input type="text" autocomplete="off" /></div><ul class="chosen-results"></ul></div>');+      }+      this.form_field_jq.hide().after(this.container);+      this.dropdown = this.container.find('div.chosen-drop').first();+      this.search_field = this.container.find('input').first();+      this.search_results = this.container.find('ul.chosen-results').first();+      this.search_field_scale();+      this.search_no_results = this.container.find('li.no-results').first();+      if (this.is_multiple) {+        this.search_choices = this.container.find('ul.chosen-choices').first();+        this.search_container = this.container.find('li.search-field').first();+      } else {+        this.search_container = this.container.find('div.chosen-search').first();+        this.selected_item = this.container.find('.chosen-single').first();+      }+      this.results_build();+      this.set_tab_index();+      return this.set_label_behavior();+    };++    Chosen.prototype.on_ready = function() {+      return this.form_field_jq.trigger("chosen:ready", {+        chosen: this+      });+    };++    Chosen.prototype.register_observers = function() {+      var _this = this;+      this.container.bind('touchstart.chosen', function(evt) {+        _this.container_mousedown(evt);+      });+      this.container.bind('touchend.chosen', function(evt) {+        _this.container_mouseup(evt);+      });+      this.container.bind('mousedown.chosen', function(evt) {+        _this.container_mousedown(evt);+      });+      this.container.bind('mouseup.chosen', function(evt) {+        _this.container_mouseup(evt);+      });+      this.container.bind('mouseenter.chosen', function(evt) {+        _this.mouse_enter(evt);+      });+      this.container.bind('mouseleave.chosen', function(evt) {+        _this.mouse_leave(evt);+      });+      this.search_results.bind('mouseup.chosen', function(evt) {+        _this.search_results_mouseup(evt);+      });+      this.search_results.bind('mouseover.chosen', function(evt) {+        _this.search_results_mouseover(evt);+      });+      this.search_results.bind('mouseout.chosen', function(evt) {+        _this.search_results_mouseout(evt);+      });+      this.search_results.bind('mousewheel.chosen DOMMouseScroll.chosen', function(evt) {+        _this.search_results_mousewheel(evt);+      });+      this.search_results.bind('touchstart.chosen', function(evt) {+        _this.search_results_touchstart(evt);+      });+      this.search_results.bind('touchmove.chosen', function(evt) {+        _this.search_results_touchmove(evt);+      });+      this.search_results.bind('touchend.chosen', function(evt) {+        _this.search_results_touchend(evt);+      });+      this.form_field_jq.bind("chosen:updated.chosen", function(evt) {+        _this.results_update_field(evt);+      });+      this.form_field_jq.bind("chosen:activate.chosen", function(evt) {+        _this.activate_field(evt);+      });+      this.form_field_jq.bind("chosen:open.chosen", function(evt) {+        _this.container_mousedown(evt);+      });+      this.form_field_jq.bind("chosen:close.chosen", function(evt) {+        _this.input_blur(evt);+      });+      this.search_field.bind('blur.chosen', function(evt) {+        _this.input_blur(evt);+      });+      this.search_field.bind('keyup.chosen', function(evt) {+        _this.keyup_checker(evt);+      });+      this.search_field.bind('keydown.chosen', function(evt) {+        _this.keydown_checker(evt);+      });+      this.search_field.bind('focus.chosen', function(evt) {+        _this.input_focus(evt);+      });+      this.search_field.bind('cut.chosen', function(evt) {+        _this.clipboard_event_checker(evt);+      });+      this.search_field.bind('paste.chosen', function(evt) {+        _this.clipboard_event_checker(evt);+      });+      if (this.is_multiple) {+        return this.search_choices.bind('click.chosen', function(evt) {+          _this.choices_click(evt);+        });+      } else {+        return this.container.bind('click.chosen', function(evt) {+          evt.preventDefault();+        });+      }+    };++    Chosen.prototype.destroy = function() {+      $(this.container[0].ownerDocument).unbind("click.chosen", this.click_test_action);+      if (this.search_field[0].tabIndex) {+        this.form_field_jq[0].tabIndex = this.search_field[0].tabIndex;+      }+      this.container.remove();+      this.form_field_jq.removeData('chosen');+      return this.form_field_jq.show();+    };++    Chosen.prototype.search_field_disabled = function() {+      this.is_disabled = this.form_field_jq[0].disabled;+      if (this.is_disabled) {+        this.container.addClass('chosen-disabled');+        this.search_field[0].disabled = true;+        if (!this.is_multiple) {+          this.selected_item.unbind("focus.chosen", this.activate_action);+        }+        return this.close_field();+      } else {+        this.container.removeClass('chosen-disabled');+        this.search_field[0].disabled = false;+        if (!this.is_multiple) {+          return this.selected_item.bind("focus.chosen", this.activate_action);+        }+      }+    };++    Chosen.prototype.container_mousedown = function(evt) {+      if (!this.is_disabled) {+        if (evt && evt.type === "mousedown" && !this.results_showing) {+          evt.preventDefault();+        }+        if (!((evt != null) && ($(evt.target)).hasClass("search-choice-close"))) {+          if (!this.active_field) {+            if (this.is_multiple) {+              this.search_field.val("");+            }+            $(this.container[0].ownerDocument).bind('click.chosen', this.click_test_action);+            this.results_show();+          } else if (!this.is_multiple && evt && (($(evt.target)[0] === this.selected_item[0]) || $(evt.target).parents("a.chosen-single").length)) {+            evt.preventDefault();+            this.results_toggle();+          }+          return this.activate_field();+        }+      }+    };++    Chosen.prototype.container_mouseup = function(evt) {+      if (evt.target.nodeName === "ABBR" && !this.is_disabled) {+        return this.results_reset(evt);+      }+    };++    Chosen.prototype.search_results_mousewheel = function(evt) {+      var delta;+      if (evt.originalEvent) {+        delta = evt.originalEvent.deltaY || -evt.originalEvent.wheelDelta || evt.originalEvent.detail;+      }+      if (delta != null) {+        evt.preventDefault();+        if (evt.type === 'DOMMouseScroll') {+          delta = delta * 40;+        }+        return this.search_results.scrollTop(delta + this.search_results.scrollTop());+      }+    };++    Chosen.prototype.blur_test = function(evt) {+      if (!this.active_field && this.container.hasClass("chosen-container-active")) {+        return this.close_field();+      }+    };++    Chosen.prototype.close_field = function() {+      $(this.container[0].ownerDocument).unbind("click.chosen", this.click_test_action);+      this.active_field = false;+      this.results_hide();+      this.container.removeClass("chosen-container-active");+      this.clear_backstroke();+      this.show_search_field_default();+      return this.search_field_scale();+    };++    Chosen.prototype.activate_field = function() {+      this.container.addClass("chosen-container-active");+      this.active_field = true;+      this.search_field.val(this.search_field.val());+      return this.search_field.focus();+    };++    Chosen.prototype.test_active_click = function(evt) {+      var active_container;+      active_container = $(evt.target).closest('.chosen-container');+      if (active_container.length && this.container[0] === active_container[0]) {+        return this.active_field = true;+      } else {+        return this.close_field();+      }+    };++    Chosen.prototype.results_build = function() {+      this.parsing = true;+      this.selected_option_count = null;+      this.results_data = SelectParser.select_to_array(this.form_field);+      if (this.is_multiple) {+        this.search_choices.find("li.search-choice").remove();+      } else if (!this.is_multiple) {+        this.single_set_selected_text();+        if (this.disable_search || this.form_field.options.length <= this.disable_search_threshold) {+          this.search_field[0].readOnly = true;+          this.container.addClass("chosen-container-single-nosearch");+        } else {+          this.search_field[0].readOnly = false;+          this.container.removeClass("chosen-container-single-nosearch");+        }+      }+      this.update_results_content(this.results_option_build({+        first: true+      }));+      this.search_field_disabled();+      this.show_search_field_default();+      this.search_field_scale();+      return this.parsing = false;+    };++    Chosen.prototype.result_do_highlight = function(el) {+      var high_bottom, high_top, maxHeight, visible_bottom, visible_top;+      if (el.length) {+        this.result_clear_highlight();+        this.result_highlight = el;+        this.result_highlight.addClass("highlighted");+        maxHeight = parseInt(this.search_results.css("maxHeight"), 10);+        visible_top = this.search_results.scrollTop();+        visible_bottom = maxHeight + visible_top;+        high_top = this.result_highlight.position().top + this.search_results.scrollTop();+        high_bottom = high_top + this.result_highlight.outerHeight();+        if (high_bottom >= visible_bottom) {+          return this.search_results.scrollTop((high_bottom - maxHeight) > 0 ? high_bottom - maxHeight : 0);+        } else if (high_top < visible_top) {+          return this.search_results.scrollTop(high_top);+        }+      }+    };++    Chosen.prototype.result_clear_highlight = function() {+      if (this.result_highlight) {+        this.result_highlight.removeClass("highlighted");+      }+      return this.result_highlight = null;+    };++    Chosen.prototype.results_show = function() {+      if (this.is_multiple && this.max_selected_options <= this.choices_count()) {+        this.form_field_jq.trigger("chosen:maxselected", {+          chosen: this+        });+        return false;+      }+      this.container.addClass("chosen-with-drop");+      this.results_showing = true;+      this.search_field.focus();+      this.search_field.val(this.search_field.val());+      this.winnow_results();+      return this.form_field_jq.trigger("chosen:showing_dropdown", {+        chosen: this+      });+    };++    Chosen.prototype.update_results_content = function(content) {+      return this.search_results.html(content);+    };++    Chosen.prototype.results_hide = function() {+      if (this.results_showing) {+        this.result_clear_highlight();+        this.container.removeClass("chosen-with-drop");+        this.form_field_jq.trigger("chosen:hiding_dropdown", {+          chosen: this+        });+      }+      return this.results_showing = false;+    };++    Chosen.prototype.set_tab_index = function(el) {+      var ti;+      if (this.form_field.tabIndex) {+        ti = this.form_field.tabIndex;+        this.form_field.tabIndex = -1;+        return this.search_field[0].tabIndex = ti;+      }+    };++    Chosen.prototype.set_label_behavior = function() {+      var _this = this;+      this.form_field_label = this.form_field_jq.parents("label");+      if (!this.form_field_label.length && this.form_field.id.length) {+        this.form_field_label = $("label[for='" + this.form_field.id + "']");+      }+      if (this.form_field_label.length > 0) {+        return this.form_field_label.bind('click.chosen', function(evt) {+          if (_this.is_multiple) {+            return _this.container_mousedown(evt);+          } else {+            return _this.activate_field();+          }+        });+      }+    };++    Chosen.prototype.show_search_field_default = function() {+      if (this.is_multiple && this.choices_count() < 1 && !this.active_field) {+        this.search_field.val(this.default_text);+        return this.search_field.addClass("default");+      } else {+        this.search_field.val("");+        return this.search_field.removeClass("default");+      }+    };++    Chosen.prototype.search_results_mouseup = function(evt) {+      var target;+      target = $(evt.target).hasClass("active-result") ? $(evt.target) : $(evt.target).parents(".active-result").first();+      if (target.length) {+        this.result_highlight = target;+        this.result_select(evt);+        return this.search_field.focus();+      }+    };++    Chosen.prototype.search_results_mouseover = function(evt) {+      var target;+      target = $(evt.target).hasClass("active-result") ? $(evt.target) : $(evt.target).parents(".active-result").first();+      if (target) {+        return this.result_do_highlight(target);+      }+    };++    Chosen.prototype.search_results_mouseout = function(evt) {+      if ($(evt.target).hasClass("active-result" || $(evt.target).parents('.active-result').first())) {+        return this.result_clear_highlight();+      }+    };++    Chosen.prototype.choice_build = function(item) {+      var choice, close_link,+        _this = this;+      choice = $('<li />', {+        "class": "search-choice"+      }).html("<span>" + item.html + "</span>");+      if (item.disabled) {+        choice.addClass('search-choice-disabled');+      } else {+        close_link = $('<a />', {+          "class": 'search-choice-close',+          'data-option-array-index': item.array_index+        });+        close_link.bind('click.chosen', function(evt) {+          return _this.choice_destroy_link_click(evt);+        });+        choice.append(close_link);+      }+      return this.search_container.before(choice);+    };++    Chosen.prototype.choice_destroy_link_click = function(evt) {+      evt.preventDefault();+      evt.stopPropagation();+      if (!this.is_disabled) {+        return this.choice_destroy($(evt.target));+      }+    };++    Chosen.prototype.choice_destroy = function(link) {+      if (this.result_deselect(link[0].getAttribute("data-option-array-index"))) {+        this.show_search_field_default();+        if (this.is_multiple && this.choices_count() > 0 && this.search_field.val().length < 1) {+          this.results_hide();+        }+        link.parents('li').first().remove();+        return this.search_field_scale();+      }+    };++    Chosen.prototype.results_reset = function() {+      this.reset_single_select_options();+      this.form_field.options[0].selected = true;+      this.single_set_selected_text();+      this.show_search_field_default();+      this.results_reset_cleanup();+      this.form_field_jq.trigger("change");+      if (this.active_field) {+        return this.results_hide();+      }+    };++    Chosen.prototype.results_reset_cleanup = function() {+      this.current_selectedIndex = this.form_field.selectedIndex;+      return this.selected_item.find("abbr").remove();+    };++    Chosen.prototype.result_select = function(evt) {+      var high, item;+      if (this.result_highlight) {+        high = this.result_highlight;+        this.result_clear_highlight();+        if (this.is_multiple && this.max_selected_options <= this.choices_count()) {+          this.form_field_jq.trigger("chosen:maxselected", {+            chosen: this+          });+          return false;+        }+        if (this.is_multiple) {+          high.removeClass("active-result");+        } else {+          this.reset_single_select_options();+        }+        item = this.results_data[high[0].getAttribute("data-option-array-index")];+        item.selected = true;+        this.form_field.options[item.options_index].selected = true;+        this.selected_option_count = null;+        if (this.is_multiple) {+          this.choice_build(item);+        } else {+          this.single_set_selected_text(item.text);+        }+        if (!((evt.metaKey || evt.ctrlKey) && this.is_multiple)) {+          this.results_hide();+        }+        this.search_field.val("");+        if (this.is_multiple || this.form_field.selectedIndex !== this.current_selectedIndex) {+          this.form_field_jq.trigger("change", {+            'selected': this.form_field.options[item.options_index].value+          });+        }+        this.current_selectedIndex = this.form_field.selectedIndex;+        return this.search_field_scale();+      }+    };++    Chosen.prototype.single_set_selected_text = function(text) {+      if (text == null) {+        text = this.default_text;+      }+      if (text === this.default_text) {+        this.selected_item.addClass("chosen-default");+      } else {+        this.single_deselect_control_build();+        this.selected_item.removeClass("chosen-default");+      }+      return this.selected_item.find("span").text(text);+    };++    Chosen.prototype.result_deselect = function(pos) {+      var result_data;+      result_data = this.results_data[pos];+      if (!this.form_field.options[result_data.options_index].disabled) {+        result_data.selected = false;+        this.form_field.options[result_data.options_index].selected = false;+        this.selected_option_count = null;+        this.result_clear_highlight();+        if (this.results_showing) {+          this.winnow_results();+        }+        this.form_field_jq.trigger("change", {+          deselected: this.form_field.options[result_data.options_index].value+        });+        this.search_field_scale();+        return true;+      } else {+        return false;+      }+    };++    Chosen.prototype.single_deselect_control_build = function() {+      if (!this.allow_single_deselect) {+        return;+      }+      if (!this.selected_item.find("abbr").length) {+        this.selected_item.find("span").first().after("<abbr class=\"search-choice-close\"></abbr>");+      }+      return this.selected_item.addClass("chosen-single-with-deselect");+    };++    Chosen.prototype.get_search_text = function() {+      if (this.search_field.val() === this.default_text) {+        return "";+      } else {+        return $('<div/>').text($.trim(this.search_field.val())).html();+      }+    };++    Chosen.prototype.winnow_results_set_highlight = function() {+      var do_high, selected_results;+      selected_results = !this.is_multiple ? this.search_results.find(".result-selected.active-result") : [];+      do_high = selected_results.length ? selected_results.first() : this.search_results.find(".active-result").first();+      if (do_high != null) {+        return this.result_do_highlight(do_high);+      }+    };++    Chosen.prototype.no_results = function(terms) {+      var no_results_html;+      no_results_html = $('<li class="no-results">' + this.results_none_found + ' "<span></span>"</li>');+      no_results_html.find("span").first().html(terms);+      this.search_results.append(no_results_html);+      return this.form_field_jq.trigger("chosen:no_results", {+        chosen: this+      });+    };++    Chosen.prototype.no_results_clear = function() {+      return this.search_results.find(".no-results").remove();+    };++    Chosen.prototype.keydown_arrow = function() {+      var next_sib;+      if (this.results_showing && this.result_highlight) {+        next_sib = this.result_highlight.nextAll("li.active-result").first();+        if (next_sib) {+          return this.result_do_highlight(next_sib);+        }+      } else {+        return this.results_show();+      }+    };++    Chosen.prototype.keyup_arrow = function() {+      var prev_sibs;+      if (!this.results_showing && !this.is_multiple) {+        return this.results_show();+      } else if (this.result_highlight) {+        prev_sibs = this.result_highlight.prevAll("li.active-result");+        if (prev_sibs.length) {+          return this.result_do_highlight(prev_sibs.first());+        } else {+          if (this.choices_count() > 0) {+            this.results_hide();+          }+          return this.result_clear_highlight();+        }+      }+    };++    Chosen.prototype.keydown_backstroke = function() {+      var next_available_destroy;+      if (this.pending_backstroke) {+        this.choice_destroy(this.pending_backstroke.find("a").first());+        return this.clear_backstroke();+      } else {+        next_available_destroy = this.search_container.siblings("li.search-choice").last();+        if (next_available_destroy.length && !next_available_destroy.hasClass("search-choice-disabled")) {+          this.pending_backstroke = next_available_destroy;+          if (this.single_backstroke_delete) {+            return this.keydown_backstroke();+          } else {+            return this.pending_backstroke.addClass("search-choice-focus");+          }+        }+      }+    };++    Chosen.prototype.clear_backstroke = function() {+      if (this.pending_backstroke) {+        this.pending_backstroke.removeClass("search-choice-focus");+      }+      return this.pending_backstroke = null;+    };++    Chosen.prototype.keydown_checker = function(evt) {+      var stroke, _ref1;+      stroke = (_ref1 = evt.which) != null ? _ref1 : evt.keyCode;+      this.search_field_scale();+      if (stroke !== 8 && this.pending_backstroke) {+        this.clear_backstroke();+      }+      switch (stroke) {+        case 8:+          this.backstroke_length = this.search_field.val().length;+          break;+        case 9:+          if (this.results_showing && !this.is_multiple) {+            this.result_select(evt);+          }+          this.mouse_on_container = false;+          break;+        case 13:+          if (this.results_showing) {+            evt.preventDefault();+          }+          break;+        case 32:+          if (this.disable_search) {+            evt.preventDefault();+          }+          break;+        case 38:+          evt.preventDefault();+          this.keyup_arrow();+          break;+        case 40:+          evt.preventDefault();+          this.keydown_arrow();+          break;+      }+    };++    Chosen.prototype.search_field_scale = function() {+      var div, f_width, h, style, style_block, styles, w, _i, _len;+      if (this.is_multiple) {+        h = 0;+        w = 0;+        style_block = "position:absolute; left: -1000px; top: -1000px; display:none;";+        styles = ['font-size', 'font-style', 'font-weight', 'font-family', 'line-height', 'text-transform', 'letter-spacing'];+        for (_i = 0, _len = styles.length; _i < _len; _i++) {+          style = styles[_i];+          style_block += style + ":" + this.search_field.css(style) + ";";+        }+        div = $('<div />', {+          'style': style_block+        });+        div.text(this.search_field.val());+        $('body').append(div);+        w = div.width() + 25;+        div.remove();+        f_width = this.container.outerWidth();+        if (w > f_width - 10) {+          w = f_width - 10;+        }+        return this.search_field.css({+          'width': w + 'px'+        });+      }+    };++    return Chosen;++  })(AbstractChosen);++}).call(this);
+ html/plugin/chosen-sprite.png view

binary file changed (absent → 538 bytes)

+ html/plugin/chosen-sprite@2x.png view

binary file changed (absent → 738 bytes)

+ html/plugin/chosen.css view
@@ -0,0 +1,437 @@+/*!+Chosen, a Select Box Enhancer for jQuery and Prototype+by Patrick Filler for Harvest, http://getharvest.com++Version 1.3.0+Full source at https://github.com/harvesthq/chosen+Copyright (c) 2011-2014 Harvest http://getharvest.com++MIT License, https://github.com/harvesthq/chosen/blob/master/LICENSE.md+This file is generated by `grunt build`, do not edit it by hand.+*/++/* @group Base */+.chosen-container {+  position: relative;+  display: inline-block;+  vertical-align: middle;+  font-size: 13px;+  zoom: 1;+  *display: inline;+  -webkit-user-select: none;+  -moz-user-select: none;+  user-select: none;+}+.chosen-container * {+  -webkit-box-sizing: border-box;+  -moz-box-sizing: border-box;+  box-sizing: border-box;+}+.chosen-container .chosen-drop {+  position: absolute;+  top: 100%;+  left: -9999px;+  z-index: 1010;+  width: 100%;+  border: 1px solid #aaa;+  border-top: 0;+  background: #fff;+  box-shadow: 0 4px 5px rgba(0, 0, 0, 0.15);+}+.chosen-container.chosen-with-drop .chosen-drop {+  left: 0;+}+.chosen-container a {+  cursor: pointer;+}++/* @end */+/* @group Single Chosen */+.chosen-container-single .chosen-single {+  position: relative;+  display: block;+  overflow: hidden;+  padding: 0 0 0 8px;+  height: 25px;+  border: 1px solid #aaa;+  border-radius: 5px;+  background-color: #fff;+  background: -webkit-gradient(linear, 50% 0%, 50% 100%, color-stop(20%, #ffffff), color-stop(50%, #f6f6f6), color-stop(52%, #eeeeee), color-stop(100%, #f4f4f4));+  background: -webkit-linear-gradient(top, #ffffff 20%, #f6f6f6 50%, #eeeeee 52%, #f4f4f4 100%);+  background: -moz-linear-gradient(top, #ffffff 20%, #f6f6f6 50%, #eeeeee 52%, #f4f4f4 100%);+  background: -o-linear-gradient(top, #ffffff 20%, #f6f6f6 50%, #eeeeee 52%, #f4f4f4 100%);+  background: linear-gradient(top, #ffffff 20%, #f6f6f6 50%, #eeeeee 52%, #f4f4f4 100%);+  background-clip: padding-box;+  box-shadow: 0 0 3px white inset, 0 1px 1px rgba(0, 0, 0, 0.1);+  color: #444;+  text-decoration: none;+  white-space: nowrap;+  line-height: 24px;+}+.chosen-container-single .chosen-default {+  color: #999;+}+.chosen-container-single .chosen-single span {+  display: block;+  overflow: hidden;+  margin-right: 26px;+  text-overflow: ellipsis;+  white-space: nowrap;+}+.chosen-container-single .chosen-single-with-deselect span {+  margin-right: 38px;+}+.chosen-container-single .chosen-single abbr {+  position: absolute;+  top: 6px;+  right: 26px;+  display: block;+  width: 12px;+  height: 12px;+  background: url('chosen-sprite.png') -42px 1px no-repeat;+  font-size: 1px;+}+.chosen-container-single .chosen-single abbr:hover {+  background-position: -42px -10px;+}+.chosen-container-single.chosen-disabled .chosen-single abbr:hover {+  background-position: -42px -10px;+}+.chosen-container-single .chosen-single div {+  position: absolute;+  top: 0;+  right: 0;+  display: block;+  width: 18px;+  height: 100%;+}+.chosen-container-single .chosen-single div b {+  display: block;+  width: 100%;+  height: 100%;+  background: url('chosen-sprite.png') no-repeat 0px 2px;+}+.chosen-container-single .chosen-search {+  position: relative;+  z-index: 1010;+  margin: 0;+  padding: 3px 4px;+  white-space: nowrap;+}+.chosen-container-single .chosen-search input[type="text"] {+  margin: 1px 0;+  padding: 4px 20px 4px 5px;+  width: 100%;+  height: auto;+  outline: 0;+  border: 1px solid #aaa;+  background: white url('chosen-sprite.png') no-repeat 100% -20px;+  background: url('chosen-sprite.png') no-repeat 100% -20px;+  font-size: 1em;+  font-family: sans-serif;+  line-height: normal;+  border-radius: 0;+}+.chosen-container-single .chosen-drop {+  margin-top: -1px;+  border-radius: 0 0 4px 4px;+  background-clip: padding-box;+}+.chosen-container-single.chosen-container-single-nosearch .chosen-search {+  position: absolute;+  left: -9999px;+}++/* @end */+/* @group Results */+.chosen-container .chosen-results {+  color: #444;+  position: relative;+  overflow-x: hidden;+  overflow-y: auto;+  margin: 0 4px 4px 0;+  padding: 0 0 0 4px;+  max-height: 240px;+  -webkit-overflow-scrolling: touch;+}+.chosen-container .chosen-results li {+  display: none;+  margin: 0;+  padding: 5px 6px;+  list-style: none;+  line-height: 15px;+  word-wrap: break-word;+  -webkit-touch-callout: none;+}+.chosen-container .chosen-results li.active-result {+  display: list-item;+  cursor: pointer;+}+.chosen-container .chosen-results li.disabled-result {+  display: list-item;+  color: #ccc;+  cursor: default;+}+.chosen-container .chosen-results li.highlighted {+  background-color: #3875d7;+  background-image: -webkit-gradient(linear, 50% 0%, 50% 100%, color-stop(20%, #3875d7), color-stop(90%, #2a62bc));+  background-image: -webkit-linear-gradient(#3875d7 20%, #2a62bc 90%);+  background-image: -moz-linear-gradient(#3875d7 20%, #2a62bc 90%);+  background-image: -o-linear-gradient(#3875d7 20%, #2a62bc 90%);+  background-image: linear-gradient(#3875d7 20%, #2a62bc 90%);+  color: #fff;+}+.chosen-container .chosen-results li.no-results {+  color: #777;+  display: list-item;+  background: #f4f4f4;+}+.chosen-container .chosen-results li.group-result {+  display: list-item;+  font-weight: bold;+  cursor: default;+}+.chosen-container .chosen-results li.group-option {+  padding-left: 15px;+}+.chosen-container .chosen-results li em {+  font-style: normal;+  text-decoration: underline;+}++/* @end */+/* @group Multi Chosen */+.chosen-container-multi .chosen-choices {+  position: relative;+  overflow: hidden;+  margin: 0;+  padding: 0 5px;+  width: 100%;+  height: auto !important;+  height: 1%;+  border: 1px solid #aaa;+  background-color: #fff;+  background-image: -webkit-gradient(linear, 50% 0%, 50% 100%, color-stop(1%, #eeeeee), color-stop(15%, #ffffff));+  background-image: -webkit-linear-gradient(#eeeeee 1%, #ffffff 15%);+  background-image: -moz-linear-gradient(#eeeeee 1%, #ffffff 15%);+  background-image: -o-linear-gradient(#eeeeee 1%, #ffffff 15%);+  background-image: linear-gradient(#eeeeee 1%, #ffffff 15%);+  cursor: text;+}+.chosen-container-multi .chosen-choices li {+  float: left;+  list-style: none;+}+.chosen-container-multi .chosen-choices li.search-field {+  margin: 0;+  padding: 0;+  white-space: nowrap;+}+.chosen-container-multi .chosen-choices li.search-field input[type="text"] {+  margin: 1px 0;+  padding: 0;+  height: 25px;+  outline: 0;+  border: 0 !important;+  background: transparent !important;+  box-shadow: none;+  color: #999;+  font-size: 100%;+  font-family: sans-serif;+  line-height: normal;+  border-radius: 0;+}+.chosen-container-multi .chosen-choices li.search-choice {+  position: relative;+  margin: 3px 5px 3px 0;+  padding: 3px 20px 3px 5px;+  border: 1px solid #aaa;+  max-width: 100%;+  border-radius: 3px;+  background-color: #eeeeee;+  background-image: -webkit-gradient(linear, 50% 0%, 50% 100%, color-stop(20%, #f4f4f4), color-stop(50%, #f0f0f0), color-stop(52%, #e8e8e8), color-stop(100%, #eeeeee));+  background-image: -webkit-linear-gradient(#f4f4f4 20%, #f0f0f0 50%, #e8e8e8 52%, #eeeeee 100%);+  background-image: -moz-linear-gradient(#f4f4f4 20%, #f0f0f0 50%, #e8e8e8 52%, #eeeeee 100%);+  background-image: -o-linear-gradient(#f4f4f4 20%, #f0f0f0 50%, #e8e8e8 52%, #eeeeee 100%);+  background-image: linear-gradient(#f4f4f4 20%, #f0f0f0 50%, #e8e8e8 52%, #eeeeee 100%);+  background-size: 100% 19px;+  background-repeat: repeat-x;+  background-clip: padding-box;+  box-shadow: 0 0 2px white inset, 0 1px 0 rgba(0, 0, 0, 0.05);+  color: #333;+  line-height: 13px;+  cursor: default;+}+.chosen-container-multi .chosen-choices li.search-choice span {+  word-wrap: break-word;+}+.chosen-container-multi .chosen-choices li.search-choice .search-choice-close {+  position: absolute;+  top: 4px;+  right: 3px;+  display: block;+  width: 12px;+  height: 12px;+  background: url('chosen-sprite.png') -42px 1px no-repeat;+  font-size: 1px;+}+.chosen-container-multi .chosen-choices li.search-choice .search-choice-close:hover {+  background-position: -42px -10px;+}+.chosen-container-multi .chosen-choices li.search-choice-disabled {+  padding-right: 5px;+  border: 1px solid #ccc;+  background-color: #e4e4e4;+  background-image: -webkit-gradient(linear, 50% 0%, 50% 100%, color-stop(20%, #f4f4f4), color-stop(50%, #f0f0f0), color-stop(52%, #e8e8e8), color-stop(100%, #eeeeee));+  background-image: -webkit-linear-gradient(top, #f4f4f4 20%, #f0f0f0 50%, #e8e8e8 52%, #eeeeee 100%);+  background-image: -moz-linear-gradient(top, #f4f4f4 20%, #f0f0f0 50%, #e8e8e8 52%, #eeeeee 100%);+  background-image: -o-linear-gradient(top, #f4f4f4 20%, #f0f0f0 50%, #e8e8e8 52%, #eeeeee 100%);+  background-image: linear-gradient(top, #f4f4f4 20%, #f0f0f0 50%, #e8e8e8 52%, #eeeeee 100%);+  color: #666;+}+.chosen-container-multi .chosen-choices li.search-choice-focus {+  background: #d4d4d4;+}+.chosen-container-multi .chosen-choices li.search-choice-focus .search-choice-close {+  background-position: -42px -10px;+}+.chosen-container-multi .chosen-results {+  margin: 0;+  padding: 0;+}+.chosen-container-multi .chosen-drop .result-selected {+  display: list-item;+  color: #ccc;+  cursor: default;+}++/* @end */+/* @group Active  */+.chosen-container-active .chosen-single {+  border: 1px solid #5897fb;+  box-shadow: 0 0 5px rgba(0, 0, 0, 0.3);+}+.chosen-container-active.chosen-with-drop .chosen-single {+  border: 1px solid #aaa;+  -moz-border-radius-bottomright: 0;+  border-bottom-right-radius: 0;+  -moz-border-radius-bottomleft: 0;+  border-bottom-left-radius: 0;+  background-image: -webkit-gradient(linear, 50% 0%, 50% 100%, color-stop(20%, #eeeeee), color-stop(80%, #ffffff));+  background-image: -webkit-linear-gradient(#eeeeee 20%, #ffffff 80%);+  background-image: -moz-linear-gradient(#eeeeee 20%, #ffffff 80%);+  background-image: -o-linear-gradient(#eeeeee 20%, #ffffff 80%);+  background-image: linear-gradient(#eeeeee 20%, #ffffff 80%);+  box-shadow: 0 1px 0 #fff inset;+}+.chosen-container-active.chosen-with-drop .chosen-single div {+  border-left: none;+  background: transparent;+}+.chosen-container-active.chosen-with-drop .chosen-single div b {+  background-position: -18px 2px;+}+.chosen-container-active .chosen-choices {+  border: 1px solid #5897fb;+  box-shadow: 0 0 5px rgba(0, 0, 0, 0.3);+}+.chosen-container-active .chosen-choices li.search-field input[type="text"] {+  color: #222 !important;+}++/* @end */+/* @group Disabled Support */+.chosen-disabled {+  opacity: 0.5 !important;+  cursor: default;+}+.chosen-disabled .chosen-single {+  cursor: default;+}+.chosen-disabled .chosen-choices .search-choice .search-choice-close {+  cursor: default;+}++/* @end */+/* @group Right to Left */+.chosen-rtl {+  text-align: right;+}+.chosen-rtl .chosen-single {+  overflow: visible;+  padding: 0 8px 0 0;+}+.chosen-rtl .chosen-single span {+  margin-right: 0;+  margin-left: 26px;+  direction: rtl;+}+.chosen-rtl .chosen-single-with-deselect span {+  margin-left: 38px;+}+.chosen-rtl .chosen-single div {+  right: auto;+  left: 3px;+}+.chosen-rtl .chosen-single abbr {+  right: auto;+  left: 26px;+}+.chosen-rtl .chosen-choices li {+  float: right;+}+.chosen-rtl .chosen-choices li.search-field input[type="text"] {+  direction: rtl;+}+.chosen-rtl .chosen-choices li.search-choice {+  margin: 3px 5px 3px 0;+  padding: 3px 5px 3px 19px;+}+.chosen-rtl .chosen-choices li.search-choice .search-choice-close {+  right: auto;+  left: 4px;+}+.chosen-rtl.chosen-container-single-nosearch .chosen-search,+.chosen-rtl .chosen-drop {+  left: 9999px;+}+.chosen-rtl.chosen-container-single .chosen-results {+  margin: 0 0 4px 4px;+  padding: 0 4px 0 0;+}+.chosen-rtl .chosen-results li.group-option {+  padding-right: 15px;+  padding-left: 0;+}+.chosen-rtl.chosen-container-active.chosen-with-drop .chosen-single div {+  border-right: none;+}+.chosen-rtl .chosen-search input[type="text"] {+  padding: 4px 5px 4px 20px;+  background: white url('chosen-sprite.png') no-repeat -30px -20px;+  background: url('chosen-sprite.png') no-repeat -30px -20px;+  direction: rtl;+}+.chosen-rtl.chosen-container-single .chosen-single div b {+  background-position: 6px 2px;+}+.chosen-rtl.chosen-container-single.chosen-with-drop .chosen-single div b {+  background-position: -12px 2px;+}++/* @end */+/* @group Retina compatibility */+@media only screen and (-webkit-min-device-pixel-ratio: 2), only screen and (min-resolution: 144dpi) {+  .chosen-rtl .chosen-search input[type="text"],+  .chosen-container-single .chosen-single abbr,+  .chosen-container-single .chosen-single div b,+  .chosen-container-single .chosen-search input[type="text"],+  .chosen-container-multi .chosen-choices .search-choice .search-choice-close,+  .chosen-container .chosen-results-scroll-down span,+  .chosen-container .chosen-results-scroll-up span {+    background-image: url('chosen-sprite@2x.png') !important;+    background-size: 52px 37px !important;+    background-repeat: no-repeat !important;+  }+}+/* @end */
+ html/plugin/jquery-cookie.js view
@@ -0,0 +1,96 @@+/**+ * Cookie plugin+ *+ * Copyright (c) 2006 Klaus Hartl (stilbuero.de)+ * Dual licensed under the MIT and GPL licenses:+ * http://www.opensource.org/licenses/mit-license.php+ * http://www.gnu.org/licenses/gpl.html+ *+ */++/**+ * Create a cookie with the given name and value and other optional parameters.+ *+ * @example $.cookie('the_cookie', 'the_value');+ * @desc Set the value of a cookie.+ * @example $.cookie('the_cookie', 'the_value', { expires: 7, path: '/', domain: 'jquery.com', secure: true });+ * @desc Create a cookie with all available options.+ * @example $.cookie('the_cookie', 'the_value');+ * @desc Create a session cookie.+ * @example $.cookie('the_cookie', null);+ * @desc Delete a cookie by passing null as value. Keep in mind that you have to use the same path and domain+ *       used when the cookie was set.+ *+ * @param String name The name of the cookie.+ * @param String value The value of the cookie.+ * @param Object options An object literal containing key/value pairs to provide optional cookie attributes.+ * @option Number|Date expires Either an integer specifying the expiration date from now on in days or a Date object.+ *                             If a negative value is specified (e.g. a date in the past), the cookie will be deleted.+ *                             If set to null or omitted, the cookie will be a session cookie and will not be retained+ *                             when the the browser exits.+ * @option String path The value of the path atribute of the cookie (default: path of page that created the cookie).+ * @option String domain The value of the domain attribute of the cookie (default: domain of page that created the cookie).+ * @option Boolean secure If true, the secure attribute of the cookie will be set and the cookie transmission will+ *                        require a secure protocol (like HTTPS).+ * @type undefined+ *+ * @name $.cookie+ * @cat Plugins/Cookie+ * @author Klaus Hartl/klaus.hartl@stilbuero.de+ */++/**+ * Get the value of a cookie with the given name.+ *+ * @example $.cookie('the_cookie');+ * @desc Get the value of a cookie.+ *+ * @param String name The name of the cookie.+ * @return The value of the cookie.+ * @type String+ *+ * @name $.cookie+ * @cat Plugins/Cookie+ * @author Klaus Hartl/klaus.hartl@stilbuero.de+ */+jQuery.cookie = function(name, value, options) {+    if (typeof value != 'undefined') { // name and value given, set cookie+        options = options || {};+        if (value === null) {+            value = '';+            options.expires = -1;+        }+        var expires = '';+        if (options.expires && (typeof options.expires == 'number' || options.expires.toUTCString)) {+            var date;+            if (typeof options.expires == 'number') {+                date = new Date();+                date.setTime(date.getTime() + (options.expires * 24 * 60 * 60 * 1000));+            } else {+                date = options.expires;+            }+            expires = '; expires=' + date.toUTCString(); // use expires attribute, max-age is not supported by IE+        }+        // CAUTION: Needed to parenthesize options.path and options.domain+        // in the following expressions, otherwise they evaluate to undefined+        // in the packed version for some reason...+        var path = options.path ? '; path=' + (options.path) : '';+        var domain = options.domain ? '; domain=' + (options.domain) : '';+        var secure = options.secure ? '; secure' : '';+        document.cookie = [name, '=', encodeURIComponent(value), expires, path, domain, secure].join('');+    } else { // only name given, get cookie+        var cookieValue = null;+        if (document.cookie && document.cookie != '') {+            var cookies = document.cookie.split(';');+            for (var i = 0; i < cookies.length; i++) {+                var cookie = jQuery.trim(cookies[i]);+                // Does this cookie string begin with the name we want?+                if (cookie.substring(0, name.length + 1) == (name + '=')) {+                    cookieValue = decodeURIComponent(cookie.substring(name.length + 1));+                    break;+                }+            }+        }+        return cookieValue;+    }+};
+ html/search.xml view
@@ -0,0 +1,21 @@+<?xml version="1.0" encoding="UTF-8"?>+<OpenSearchDescription xmlns="http://a9.com/-/spec/opensearch/1.1/">+    <ShortName>Hoogle</ShortName>+    <LongName>Hoogle - Haskell API Search</LongName>+    <Description>+        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.+    </Description>+    <Tags>haskell</Tags>+    <Url type="text/html" template="https://hoogle.haskell.org/?hoogle={searchTerms}"/>+    <Url type="application/x-suggestions+json" template="https://hoogle.haskell.org/?hoogle={searchTerms}&amp;mode=suggest"/>++    <Image height="16" width="16" type="image/png">https://hoogle.haskell.org/favicon.png</Image>+    <Image height="64" width="64" type="image/png">https://hoogle.haskell.org/favicon64.png</Image>+    <Developer>Neil Mitchell</Developer>+    <AdultContent>false</AdultContent>+    <Language>en-us</Language>+    <OutputEncoding>UTF-8</OutputEncoding>+    <InputEncoding>UTF-8</InputEncoding>+</OpenSearchDescription>
+ html/welcome.html view
@@ -0,0 +1,31 @@+<h1>Welcome to Hoogle</h1>+<ul id="left">+<li><b>Links</b></li>+<li><a href="https://www.haskell.org">Haskell.org</a></li>+<li><a href="https://hackage.haskell.org">Hackage</a></li>+<li><a href="https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/">GHC Manual</a></li>+<li><a href="https://downloads.haskell.org/~ghc/latest/docs/html/libraries/">Libraries</a></li>+</ul>+<p>+    Hoogle is a Haskell API search engine, which allows you to search the Haskell libraries+    on Stackage by either function name, or by approximate type signature.+</p>+<p id="example">+    Example searches:<br/>+    <a href="?hoogle=map">map</a><br/>+    <a href="?hoogle=(a%20-&gt;%20b)%20-&gt;%20%5Ba%5D%20-&gt;%20%5Bb%5D">(a -&gt; b) -&gt; [a] -&gt; [b]</a><br/>+    <a href="?hoogle=Ord%20a%20%3D&gt;%20%5Ba%5D%20-&gt;%20%5Ba%5D">Ord a =&gt; [a] -&gt; [a]</a><br/>+    <a href="?hoogle=Data.Set.insert">Data.Set.insert</a><br/>+    <a href="?hoogle=%2Bbytestring+concat">+bytestring concat</a><br/>+    <br/>Enter your own search at the top of the page.+</p>+<p>+    The <a href="https://wiki.haskell.org/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://ndmitchell.com">email me</a>, or add an entry to my+    <a href="https://github.com/ndmitchell/hoogle/issues">bug tracker</a>.+</p>
+ misc/sample-data/emily-1.11/emily.txt view
@@ -0,0 +1,9 @@+@url http://eghmitchell.com/+@package emily+@version 1.11++module Mitchell++@url #a_wife+type family Wife (a :: Mother)+paleo :: Bool
+ misc/sample-data/emily-1.2/emily.txt view
@@ -0,0 +1,7 @@+@url http://eghmitchell.co.uk/+@package emily+@version 1.2++module Mitchell+@url #a_wife+type family Wife (a :: Mother)
+ misc/sample-data/henry.txt view
@@ -0,0 +1,6 @@+@package henry++module Mitchell++@url http://henry.com?too_long+__prefix__really_long_string_take_might_overflow_any_poorly_chosen_word8_buffers_because_someone_decided_their_identifiers_should_be_untypeable_by_mere_humans__infix__and_that_their_sample_code_should_not_fit_into_tweets_or_even_single_lines_because_they_are_definitely_too_long__suffix__ :: a -> b
+ misc/settings.txt view
@@ -0,0 +1,34 @@+-- A list of settings, installed as a data file on the users machine.++-- Applied to cabal fields when the same semantic value is used multiple times with+-- typos/names/capitalisation.+RenameTag "Silk-B.V." "Silk"+RenameTag "Silk.-B.V." "Silk"+RenameTag "Michael-snoyman" "Michael-Snoyman"+RenameTag "Apache-2.0" "Apache"+RenameTag "GPL-3" "GPL"+RenameTag "LGPL-2.1" "LGPL"+RenameTag "LGPL-3" "LGPL"+RenameTag "graphics" "Graphics"+RenameTag "math" "Math"+RenameTag "Unclassified" ""+RenameTag "data" "Data"+RenameTag "Edward-A.-Kmett" "Edward-Kmett"+RenameTag "Jose-Pedro-Magalhaes" "José-Pedro-Magalhães"+RenameTag "AUTHORS" ""+RenameTag "contributors-see-README" ""+RenameTag "author" ""+RenameTag "http://www.cse.chalmers.se/~nad/" "Nils Anders Danielsson"+RenameTag "many-others" ""+RenameTag "Error-handling" "Error-Handling"+RenameTag "Daniel-Schüssler" "Daniel Schüssler"+RenameTag "Various" ""+RenameTag "Various;-see-individual-modules" ""++-- Reorder modules so the common things come first+ReorderModule "base" "Prelude"        1009+ReorderModule "base" "Data.List"      1008+ReorderModule "base" "Data.Maybe"     1007+ReorderModule "base" "Data.Function"  1006+ReorderModule "base" "Control.Monad"  1005+ReorderModule "base" "GHC.*"        (-1000)
+ src/Action/CmdLine.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-missing-fields -fno-cse #-}++module Action.CmdLine(+    CmdLine(..), Language(..),+    getCmdLine, defaultDatabaseLang,+    defaultGenerate,+    whenLoud, whenNormal+    ) where++import Data.List.Extra+import Data.Version+import General.Util+import Paths_hoogle (version)+import System.Console.CmdArgs+import System.Directory+import System.Environment+import System.FilePath+import System.IO++data Language = Haskell | Frege deriving (Data,Typeable,Show,Eq,Enum,Bounded)++data CmdLine+    = Search+        {color :: Maybe Bool+        ,json :: Bool+        ,jsonl :: Bool+        ,link :: Bool+        ,numbers :: Bool+        ,info :: Bool+        ,database :: FilePath+        ,count :: Maybe Int+        ,query :: [String]+        ,repeat_ :: Int+        ,language :: Language+        ,compare_ :: [String]+        }+    | Generate+        {download :: Maybe Bool+        ,database :: FilePath+        ,insecure :: Bool+        ,include :: [String]+        ,count :: Maybe Int+        ,local_ :: [FilePath]+        ,haddock :: Maybe FilePath+        ,debug :: Bool+        ,language :: Language+        }+    | Server+        {port :: Int+        ,database :: FilePath+        ,cdn :: String+        ,logs :: FilePath+        ,local :: Bool+        ,haddock :: Maybe FilePath+        ,links :: Bool+        ,language :: Language+        ,scope :: String+        ,home :: String+        ,host :: String+        ,https :: Bool+        ,cert :: FilePath+        ,key :: FilePath+        ,datadir :: Maybe FilePath+        ,no_security_headers :: Bool+        }+    | Replay+        {logs :: FilePath+        ,database :: FilePath+        ,repeat_ :: Int+        ,language :: Language+        ,scope :: String+        }+    | Test+        { deep :: Bool+        , disable_network_tests  :: Bool+        , database :: FilePath+        , language :: Language+        }+      deriving (Data,Typeable,Show)++defaultDatabaseLang :: Language -> IO FilePath+defaultDatabaseLang lang = do+    xdgLocation <- getXdgDirectory XdgData "hoogle"+    legacyLocation <- getAppUserDataDirectory "hoogle"+    doesXdgPathExist <- doesPathExist xdgLocation+    doesLegacyPathExist <- doesPathExist legacyLocation++    dir <- case (doesXdgPathExist, doesLegacyPathExist) of+      -- On Windows XDG location and legacy location are identical+      _ | xdgLocation == legacyLocation -> pure xdgLocation+      (_, False) -> pure xdgLocation+      (True, True) -> do+        hPutStrLn stderr $+          "Warning: Legacy location ignored (" ++ legacyLocation ++ "),"+          ++ "since xdg location is available (" ++ xdgLocation ++")."+        pure xdgLocation+      (False, True) -> do+        -- TODO: renable after release+        --hPutStrLn stderr $ "Warning: " ++ legacyLocation ++ " is deprecated."+        --  ++ "Consider moving it to $XDG_DATA_HOME/hoogle (" ++ xdgLocation ++ ")"+        pure legacyLocation+    pure $ dir </> "default-" ++ lower (show lang) ++ "-" ++ showVersion (trimVersion 3 version) ++ ".hoo"++getCmdLine :: [String] -> IO CmdLine+getCmdLine args = do+    args <- withArgs args $ cmdArgsRun cmdLineMode++    -- fill in the default database+    args <- if database args /= "" then pure args else do+        db <- defaultDatabaseLang $ language args; pure args{database=db}++    -- fix up people using Hoogle 4 instructions+    args <- case args of+        Generate{..} | "all" `elem` include -> do+            putStrLn "Warning: 'all' argument is no longer required, and has been ignored."+            pure $ args{include = delete "all" include}+        _ -> pure args++    pure args+++defaultGenerate :: CmdLine+defaultGenerate = generate{language=Haskell}+++cmdLineMode = cmdArgsMode $ modes [search_ &= auto,generate,server,replay,test]+    &= verbosity &= program "hoogle"+    &= summary ("Hoogle " ++ showVersion version ++ ", https://hoogle.haskell.org/")++search_ = Search+    {color = def &= name "colour" &= help "Use colored output (requires ANSI terminal)"+    ,json = def &= name "json" &= help "Get result as JSON"+    ,jsonl = def &= name "jsonl" &= help "Get result as JSONL (JSON Lines)"+    ,link = def &= help "Give URL's for each result"+    ,numbers = def &= help "Give counter for each result"+    ,info = def &= help "Give extended information about the first n results (set n with --count, default is 1)"+    ,database = def &= typFile &= help "Name of database to use (use .hoo extension)"+    ,count = Nothing &= name "n" &= help "Maximum number of results to return (defaults to 10)"+    ,query = def &= args &= typ "QUERY"+    ,repeat_ = 1 &= help "Number of times to repeat (for benchmarking)"+    ,language = enum [x &= explicit &= name (lower $ show x) &= help ("Work with " ++ show x) | x <- enumerate] &= groupname "Language"+    ,compare_ = def &= help "Type signatures to compare against"+    } &= help "Perform a search"++generate = Generate+    {download = def &= help "Download all files from the web"+    ,insecure = def &= help "Allow insecure HTTPS connections"+    ,include = def &= args &= typ "PACKAGE"+    ,local_ = def &= opt "" &= help "Index local packages and link to local haddock docs"+    ,count = Nothing &= name "n" &= help "Maximum number of packages to index (defaults to all)"+    ,haddock = def &= help "Use local haddocks"+    ,debug = def &= help "Generate debug information"+    } &= help "Generate Hoogle databases"++server = Server+    {port = 8080 &= typ "INT" &= help "Port number"+    ,cdn = "" &= typ "URL" &= help "URL prefix to use"+    ,logs = "" &= opt "log.txt" &= typFile &= help "File to log requests to (defaults to stdout)"+    ,local = False &= help "Allow following file:// links, restricts to 127.0.0.1  Set --host explicitely (including to '*' for any host) to override the localhost-only behaviour"+    ,haddock = def &= help "Serve local haddocks from a specified directory"+    ,scope = def &= help "Default scope to start with"+    ,links = def &= help "Display extra links"+    ,home = "https://hoogle.haskell.org" &= typ "URL" &= help "Set the URL linked to by the Hoogle logo."+    ,host = "" &= help "Set the host to bind on (e.g., an ip address; '!4' for ipv4-only; '!6' for ipv6-only; default: '*' for any host)."+    ,https = def &= help "Start an https server (use --cert and --key to specify paths to the .pem files)"+    ,cert = "cert.pem" &= typFile &= help "Path to the certificate pem file (when running an https server)"+    ,key = "key.pem" &= typFile &= help "Path to the key pem file (when running an https server)"+    ,datadir = def &= help "Override data directory paths"+    ,no_security_headers = False &= help "Don't send CSP security headers"+    } &= help "Start a Hoogle server"++replay = Replay+    {logs = "log.txt" &= args &= typ "FILE"+    } &= help "Replay a log file"++test = Test+    { deep    = False &= help "Run extra long tests"+    , disable_network_tests = False  &= help "Disables the use of network tests"+    } &= help "Run the test suite"
+ src/Action/Generate.hs view
@@ -0,0 +1,318 @@+{-# LANGUAGE ViewPatterns, TupleSections, RecordWildCards, ScopedTypeVariables, PatternGuards #-}++module Action.Generate(actionGenerate) where++import Data.List.Extra+import System.FilePath+import System.Directory.Extra+import System.IO.Extra+import Data.Tuple.Extra+import Control.Exception.Extra+import Data.IORef+import Data.Maybe+import qualified Data.Set as Set+import qualified Data.Map.Strict as Map+import Control.Monad.Extra+import Data.Monoid+import Data.Ord+import System.Console.CmdArgs.Verbosity+import Prelude++import Output.Items+import Output.Tags+import Output.Names+import Output.Types+import Input.Cabal+import Input.Haddock+import Input.Download+import Input.Reorder+import Input.Set+import Input.Settings+import Input.Item+import General.Util+import General.Store+import General.Timing+import General.Str+import Action.CmdLine+import General.Conduit+import Control.DeepSeq+import Distribution.Package (mkPackageName, unPackageName)++{-+++data GenList+    = GenList_Package String -- a literally named package+    | GenList_GhcPkg String -- command to run, or "" for @ghc-pkg list@+    | GenList_Stackage String -- URL of stackage file, defaults to @http://www.stackage.org/lts/cabal.config@+    | GenList_Dependencies String -- dependencies in a named .cabal file+    | GenList_Sort String -- URL of file to sort by, defaults to @http://packdeps.haskellers.com/reverse@++data GenTags+    = GenTags_GhcPkg String -- command to run, or "" for @ghc-pkg dump@+    | GenTags_Diff FilePath -- a diff to apply to previous metadata+    | GenTags_Tarball String -- tarball of Cabal files, defaults to http://hackage.haskell.org/packages/index.tar.gz+    | GetTags_Cabal FilePath -- tarball to get tag information from++data GenData+    = GenData_File FilePath -- a file containing package data+    | GenData_Tarball String -- URL where a tarball of data files resides+++* `hoogle generate` - generate for all things in Stackage based on Hackage information.+* `hoogle generate --source=file1.txt --source=local --source=stackage --source=hackage --source=tarball.tar.gz`++Which files you want to index. Currently the list on stackage, could be those locally installed, those in a .cabal file etc. A `--list` flag, defaults to `stackage=url`. Can also be `ghc-pkg`, `ghc-pkg=user` `ghc-pkg=global`. `name=p1`.++Extra metadata you want to apply. Could be a file. `+shake author:Neil-Mitchell`, `-shake author:Neil-Mitchel`. Can be sucked out of .cabal files. A `--tags` flag, defaults to `tarball=url` and `diff=renamings.txt`.++Where the haddock files are. Defaults to `tarball=hackage-url`. Can also be `file=p1.txt`. Use `--data` flag.++Defaults to: `hoogle generate --list=ghc-pkg --list=constrain=stackage-url`.++Three pieces of data:++* Which packages to index, in order.+* Metadata.+++generate :: Maybe Int -> [GenList] -> [GenTags] -> [GenData] -> IO ()+-- how often to redownload, where to put the files++++generate :: FilePath -> [(String, [(String, String)])] -> [(String, LBS.ByteString)] -> IO ()+generate output metadata = ...+-}+++-- -- generate all+-- @tagsoup -- generate tagsoup+-- @tagsoup filter -- search the tagsoup package+-- filter -- search all++type Download = String -> URL -> IO FilePath++readHaskellOnline :: Timing -> Settings -> Download -> IO (Map.Map PkgName Package, Set.Set PkgName, ConduitT () (PkgName, URL, LBStr) IO ())+readHaskellOnline timing settings download = do+    stackageLts <- download "haskell-stackage-lts.txt" "https://www.stackage.org/lts/cabal.config"+    stackageNightly <- download "haskell-stackage-nightly.txt" "https://www.stackage.org/nightly/cabal.config"+    platform <- download "haskell-platform.txt" "https://raw.githubusercontent.com/haskell/haskell-platform/master/hptool/src/Releases2015.hs"+    cabals   <- download "haskell-cabal.tar.gz" "https://hackage.haskell.org/packages/index.tar.gz"+    hoogles  <- download "haskell-hoogle.tar.gz" "https://hackage.haskell.org/packages/hoogle.tar.gz"++    -- peakMegabytesAllocated = 2+    setStackage <- Set.map mkPackageName <$> (Set.union <$> setStackage stackageLts <*> setStackage stackageNightly)+    setPlatform <- Set.map mkPackageName <$> setPlatform platform+    setGHC <- Set.map mkPackageName <$> setGHC platform++    cbl <- timed timing "Reading Cabal" $ parseCabalTarball settings cabals+    let want = Set.insert (mkPackageName "ghc") $ Set.unions [setStackage, setPlatform, setGHC]+    cbl <- pure $ flip Map.mapWithKey cbl $ \name p ->+        p{packageTags =+            [(strPack "set",strPack "included-with-ghc") | name `Set.member` setGHC] +++            [(strPack "set",strPack "haskell-platform") | name `Set.member` setPlatform] +++            [(strPack "set",strPack "stackage") | name `Set.member` setStackage] +++            packageTags p}++    let source = do+            tar <- liftIO $ tarballReadFiles hoogles+            forM_ tar $ \(mkPackageName . takeBaseName -> name, src) ->+                yield (name, hackagePackageURL name, src)+    pure (cbl, want, source)+++readHaskellDirs :: Timing -> Settings -> [FilePath] -> IO (Map.Map PkgName Package, Set.Set PkgName, ConduitT () (PkgName, URL, LBStr) IO ())+readHaskellDirs timing settings dirs = do+    files <- concatMapM listFilesRecursive dirs+    -- We reverse/sort the list because of #206+    -- Two identical package names with different versions might be foo-2.0 and foo-1.0+    -- We never distinguish on versions, so they are considered equal when reordering+    -- So put 2.0 first in the list and rely on stable sorting. A bit of a hack.+    let order a = second Down $ parseTrailingVersion a+    let packages = map (mkPackageName . takeBaseName &&& id) $ sortOn (map order . splitDirectories) $ filter ((==) ".txt" . takeExtension) files+    cabals <- mapM parseCabal $ filter ((==) ".cabal" . takeExtension) files+    let source = forM_ packages $ \(name, file) -> do+            src <- liftIO $ bstrReadFile file+            dir <- liftIO $ canonicalizePath $ takeDirectory file+            let url = "file://" ++ ['/' | not $ "/" `isPrefixOf` dir] ++ replace "\\" "/" dir ++ "/"+            when (isJust $ bstrSplitInfix (bstrPack "@package " <> bstrPack (unPackageName name)) src) $+                yield (name, url, lbstrFromChunks [src])+    pure (Map.union+                (Map.fromList cabals)+                (Map.fromListWith (<>) $ map generateBarePackage packages)+           ,Set.fromList $ map fst packages, source)+  where+    parseCabal fp = do+        src <- bstrReadFile fp+        let pkg = readCabal settings src+        pure (mkPackageName $ takeBaseName fp, pkg)++    generateBarePackage (name, file) =+        (name, mempty{packageTags = (strPack "set", strPack "all") : sets})+      where+        sets = map setFromDir $ filter (`isPrefixOf` file) dirs+        setFromDir dir = (strPack "set", strPack $ takeFileName $ dropTrailingPathSeparator dir)++readFregeOnline :: Timing -> Download -> IO (Map.Map PkgName Package, Set.Set PkgName, ConduitT () (PkgName, URL, LBStr) IO ())+readFregeOnline timing download = do+    frege <- download "frege-frege.txt" "https://github.com/Frege/try-frege/raw/refs/heads/master/try-frege-web/src/main/webapp/hoogle-frege.txt"+    let source = do+            src <- liftIO $ bstrReadFile frege+            yield (mkPackageName "frege", "http://google.com/", lbstrFromChunks [src])+    pure (Map.empty, Set.singleton $ mkPackageName "frege", source)+++readHaskellGhcpkg :: Timing -> Settings -> IO (Map.Map PkgName Package, Set.Set PkgName, ConduitT () (PkgName, URL, LBStr) IO ())+readHaskellGhcpkg timing settings = do+    cbl <- timed timing "Reading ghc-pkg" $ readGhcPkg settings+    let source =+            forM_ (Map.toList cbl) $ \(name,Package{..}) -> whenJust packageDocs $ \docs -> do+                let file = docs </> unPackageName name <.> "txt"+                whenM (liftIO $ doesFileExist file) $ do+                    src <- liftIO $ bstrReadFile file+                    docs <- liftIO $ canonicalizePath docs+                    let url = "file://" ++ ['/' | not $ all isPathSeparator $ take 1 docs] +++                              replace "\\" "/" (addTrailingPathSeparator docs)+                    yield (name, url, lbstrFromChunks [src])+    cbl <- pure $ let ts = map (both strPack) [("set","stackage"),("set","installed")]+                    in Map.map (\p -> p{packageTags = ts ++ packageTags p}) cbl+    pure (cbl, Map.keysSet cbl, source)++-- | @hoogle generate --haddock=path/to/doc@ works similarly to @hoogle generate --local@,+-- getting package info from a local ghc-pkg database, but uses @path/to/doc@+-- as the canonical source of Haddock documentation.+-- @path/to/doc@ should be a path to the directory that contains the root @index.html@+-- generated by cabal haddock or stack haddock.+-- Paths stored in the database are relative to this root.+--+-- @hoogle server --haddock=path/to/doc@ is intended to be used with a database+-- containing relative paths. In contrast to @hoogle server --local@,+-- paths relative to the filesystem root are not allowed;+-- only files from @path/to/doc@ are served.+--+-- These features are intended to be used together, when you want to+-- create a Hoogle index for your project in one place, then serve it somewhere else.+-- This enables a workflow such as the following:+--+-- 1. Run cabal haddock or stack haddock on your build server+-- 2. Run hoogle generate --haddock=path/to/doc on your build server (this assumes you know where the docs were written)+-- 3. Deploy the Hoogle database and Haddock files to your documentation server & run hoogle server --haddock=new/path/to/doc+--+-- from https://github.com/ndmitchell/hoogle/pull/202+readHaskellHaddock :: Timing -> Settings -> FilePath -> IO (Map.Map PkgName Package, Set.Set PkgName, ConduitT () (PkgName, URL, LBStr) IO ())+readHaskellHaddock timing settings docBaseDir = do+    cbl <- timed timing "Reading ghc-pkg" $ readGhcPkg settings+    let source =+            forM_ (Map.toList cbl) $ \(name, p@Package{..}) -> do+                let docs = docDir (unPackageName name) p+                    file = docBaseDir </> docs </> unPackageName name <.> "txt"+                whenM (liftIO $ doesFileExist file) $ do+                    src <- liftIO $ bstrReadFile file+                    let url = ['/' | not $ all isPathSeparator $ take 1 docs] +++                              replace "\\" "/" (addTrailingPathSeparator docs)+                    yield (name, url, lbstrFromChunks [src])+    cbl <- pure $ let ts = map (both strPack) [("set","stackage"),("set","installed")]+                    in Map.map (\p -> p{packageTags = ts ++ packageTags p}) cbl+    pure (cbl, Map.keysSet cbl, source)++    where docDir name Package{..} = name ++ "-" ++ strUnpack packageVersion++actionGenerate :: CmdLine -> IO ()+actionGenerate g@Generate{..} = withTiming (if debug then Just $ replaceExtension database "timing" else Nothing) $ \timing -> do+    putStrLn "Starting generate"+    createDirectoryIfMissing True $ takeDirectory database+    whenLoud $ putStrLn $ "Generating files to " ++ takeDirectory database++    let warnFlagIgnored thisFlag reason ignoredFlagPred ignoredFlag =+          when ignoredFlagPred $ putStrLn $ "Warning: " <> thisFlag <> " is " <> reason <> ", which means " <> ignoredFlag <> " is ignored."++    let doDownload name url = do+          let download' = case download of+                Just True -> AlwaysDownloadInput+                Just False -> NeverDownloadInput+                Nothing -> DownloadInputIfNotThere+          downloadInput timing insecure download' (takeDirectory database) name url++    settings <- loadSettings+    (cbl, want, source) <- case language of+        Haskell | Just dir <- haddock -> do+                    warnFlagIgnored "--haddock" "set" (local_ /= []) "--local"+                    warnFlagIgnored "--haddock" "set" (isJust download) "--download"+                    readHaskellHaddock timing settings dir+                | [""] <- local_ -> do+                    warnFlagIgnored "--local" "used as flag (no paths)" (isJust download) "--download"+                    readHaskellGhcpkg timing settings+                | [] <- local_ -> do readHaskellOnline timing settings doDownload+                | otherwise -> readHaskellDirs timing settings local_+        Frege | [] <- local_ -> readFregeOnline timing doDownload+              | otherwise -> errorIO "No support for local Frege databases"+    (cblErrs, popularity) <- evaluate $ packagePopularity cbl+    cbl <- evaluate $ Map.map (\p -> p{packageDepends=[]}) cbl -- clear the memory, since the information is no longer used+    evaluate popularity++    want <- pure $ if include /= [] then Set.fromList $ map mkPackageName include else want+    want <- pure $ case count of Nothing -> want; Just count -> Set.fromList $ take count $ Set.toList want++    (stats, _) <- storeWriteFile database $ \store -> do+        xs <- withBinaryFile (database `replaceExtension` "warn") WriteMode $ \warnings -> do+            hSetEncoding warnings utf8+            hPutStr warnings $ unlines cblErrs+            nCblErrs <- evaluate $ length cblErrs++            itemWarn <- newIORef 0+            let warning msg = do modifyIORef itemWarn succ; hPutStrLn warnings msg++            let consume :: ConduitM (Int, (PkgName, URL, LBStr)) (Maybe Target, [Item]) IO ()+                consume = awaitForever $ \(i, (unPackageName -> pkg, url, body)) -> do+                    timedOverwrite timing ("[" ++ show i ++ "/" ++ show (Set.size want) ++ "] " ++ pkg) $+                        parseHoogle (\msg -> warning $ pkg ++ ":" ++ msg) url body++            writeItems store $ \items -> do+                xs <- runConduit $+                    source .|+                    filterC (flip Set.member want . fst3) .|+                    void ((|$|)+                        (zipFromC 1 .| consume)+                        (do seen <- fmap Set.fromList $ mapMC (evaluate . force . fst3) .| sinkList+                            let missing = [x | x <- Set.toList $ want `Set.difference` seen+                                             , fmap packageLibrary (Map.lookup x cbl) /= Just False]+                            liftIO $ putStrLn ""+                            liftIO $ whenNormal $ when (missing /= []) $ do+                                putStrLn $ "Packages missing documentation: " ++ unwords (sortOn lower $ map unPackageName missing)+                            liftIO $ when (Set.null seen) $+                                exitFail "No packages were found, aborting (use no arguments to index all of Stackage)"+                            -- synthesise things for Cabal packages that are not documented+                            forM_ (Map.toList cbl) $ \(name, Package{..}) -> when (name `Set.notMember` seen) $ do+                                let ret prefix = yield $ fakePackage name $ prefix ++ trim (strUnpack packageSynopsis)+                                if name `Set.member` want then+                                    (if packageLibrary+                                        then ret "Documentation not found, so not searched.\n"+                                        else ret "Executable only. ")+                                else if null include then+                                    ret "Not on Stackage, so not searched.\n"+                                else+                                    pure ()+                            ))+                    .| pipelineC 10 (items .| sinkList)++                itemWarn <- readIORef itemWarn+                when (itemWarn > 0) $+                    putStrLn $ "Found " ++ show itemWarn ++ " warnings when processing items"+                pure [(a,b) | (a,bs) <- xs, b <- bs]++        itemsMemory <- getStatsCurrentLiveBytes+        xs <- timed timing "Reordering items" $ pure $! reorderItems settings (\s -> maybe 1 negate $ Map.lookup s popularity) xs+        timed timing "Writing tags" $ writeTags store (`Set.member` want) (\x -> maybe [] (map (both strUnpack) . packageTags) $ Map.lookup x cbl) xs+        timed timing "Writing names" $ writeNames store xs+        timed timing "Writing types" $ writeTypes store (if debug then Just $ dropExtension database else Nothing) xs++        x <- getVerbosity+        when (x >= Loud) $+            whenJustM getStatsDebug print+        when (x >= Normal) $ do+            whenJustM getStatsPeakAllocBytes $ \x ->+                putStrLn $ "Peak of " ++ x ++ ", " ++ fromMaybe "unknown" itemsMemory ++ " for items"++    when debug $+        writeFile (database `replaceExtension` "store") $ unlines stats
+ src/Action/Search.hs view
@@ -0,0 +1,398 @@+{-# LANGUAGE LambdaCase, MultiWayIf, RecordWildCards, ScopedTypeVariables,+             TupleSections #-}++module Action.Search+    (actionSearch, withSearch, search+    ,targetInfo+    ,targetResultDisplay+    ,action_search_test+    ) where++import Control.DeepSeq+import Control.Exception.Extra+import Control.Monad.Extra+import qualified Data.Aeson as JSON+import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Functor.Identity+import Data.List.Extra+import qualified Data.Map as Map+import Data.Maybe+import qualified Data.Set as Set+import System.Directory+import Text.Blaze.Renderer.Utf8+import Safe+import System.Console.ANSI+    (hSupportsANSI, hyperlinkCode, setSGRCode+    ,SGR (SetColor), ConsoleLayer (Foreground)+    ,ColorIntensity (Vivid, Dull), Color (Yellow))+import System.IO (stdout)++import Action.CmdLine+import General.Store+import General.Util+import Input.Item+import Output.Items+import Output.Names+import Output.Tags+import Output.Types+import Query++-- -- generate all+-- @tagsoup -- generate tagsoup+-- @tagsoup filter -- search the tagsoup package+-- filter -- search all++actionSearch :: CmdLine -> IO ()+actionSearch Search{..} = replicateM_ repeat_ $ -- deliberately reopen the database each time+    withSearch database $ \store ->+        if null compare_ then do+            count' <- pure $ fromMaybe 10 count+            (q, res) <- pure $ search store $ parseQuery $ unwords query+            whenLoud $ putStrLn $ "Query: " ++ unescapeHTML (LBS.unpack $ renderMarkup $ renderQuery q)+            color' <- case color of+              Just b -> pure b+              Nothing -> hSupportsANSI stdout+            let (shown, hidden) = splitAt count' $ nubOrd $ map (targetResultDisplay link color' q) res+            if null res then+                putStrLn "No results found"+             else if info then do+                 mapM_ (putStr . targetInfo color' q)+                  $ (case count of+                    Just c -> take c+                    Nothing -> singleton . headErr) res+             else do+                if | json -> LBS.putStrLn $ JSON.encode $ maybe id take count $ map unHTMLtargetItem res+                   | jsonl -> mapM_ (LBS.putStrLn . JSON.encode) $ maybe id take count $ map unHTMLtargetItem res+                   | otherwise -> putStr $ unlines $ if numbers then addCounter shown else shown+                when (hidden /= [] && not json) $ do+                    whenNormal $ putStrLn $ "-- plus more results not shown, pass --count=" ++ show (count'+10) ++ " to see more"+        else do+            let parseType x = case parseQuery x of+                                  [QueryType t] -> (pretty t, hseToSig t)+                                  _ -> error $ "Expected a type signature, got: " ++ x+            putStr $ unlines $ searchFingerprintsDebug store (parseType $ unwords query) (map parseType compare_)++-- | Returns the details printed out when hoogle --info is called+targetInfo :: Bool -> [Query] -> Target -> String+targetInfo color qs Target{..} =+    unlines $ [ unHTML . (if color then ansiHighlight qs else id) $ targetItem ] +++              [ unwords packageModule | not $ null packageModule] +++              [ unHTML targetDocs ]+            where packageModule = map fst $ catMaybes [targetPackage, targetModule]++-- | Returns the Target formatted as an item to display in the results+-- | Bool arguments decide whether links and colors are shown+targetResultDisplay :: Bool -> Bool -> [Query] -> Target -> String+targetResultDisplay link color qs Target{..} = unHTML $ unwords $+        map fst (maybeToList targetModule) +++        [if color then highlightFull targetItem else targetItem] +++        ["-- " ++ targetURL | link]+     where+        highlightFull = hyperlinkCode targetURL . ansiHighlight qs++ansiHighlight :: [Query] -> String -> String+ansiHighlight = highlightItem id id ((dull ++) . (++ rst)) ((bold ++) . (++ rst))+    where+        dull = setSGRCode [SetColor Foreground Dull Yellow]+        bold = setSGRCode [SetColor Foreground Vivid Yellow]+        rst = setSGRCode []++unHTMLtargetItem :: Target -> Target+unHTMLtargetItem target = target {targetItem = unHTML $ targetItem target}++addCounter :: [String] -> [String]+addCounter = zipWithFrom (\i x -> show i ++ ") " ++ x) 1++withSearch :: NFData a => FilePath -> (StoreRead -> IO a) -> IO a+withSearch database act = do+    unlessM (doesFileExist database) $ do+        exitFail $ "Error, database does not exist (run 'hoogle generate' first)\n" +++                   "    Filename: " ++ database+    storeReadFile database act+++search :: StoreRead -> [Query] -> ([Query], [Target])+search store qs = runIdentity $ do+    (qs, exact, filt, list) <- pure $ applyTags store  qs+    is <- case (filter isQueryName qs, filter isQueryType qs) of+        ([], [] ) -> pure list+        ([], t:_) -> pure $ searchTypes store $ hseToSig $ fromQueryType t+        (xs, [] ) -> pure $ searchNames store exact $ map fromQueryName xs+        (xs, t:_) -> do+            nam <- pure $ Set.fromList $ searchNames store exact $ map fromQueryName xs+            pure $ filter (`Set.member` nam) $ searchTypes store $ hseToSig $ fromQueryType t+    let look = lookupItem store+    pure (qs, map look $ filter filt is)++action_search_test :: Bool -> FilePath -> IO ()+action_search_test sample database = testing "Action.Search.search" $ withSearch database $ \store -> do+    let noResults a = do+          res <- pure $ snd $ search store (parseQuery a)+          case res of+              [] -> putChar '.'+              _ -> errorIO $ "Searching for: " ++ show a ++ "\nGot: " ++ show (take 1 res) ++ "\n expected none"+    let a ==$ f = do+            res <- pure $ snd $ search store (parseQuery a)+            case res of+                Target{..}:_ | f targetURL -> putChar '.'+                _ -> errorIO $ "Searching for: " ++ show a ++ "\nGot: " ++ show (take 1 res)+    let a === b = a ==$ (== b)++    let query :: String -> [ExpectedQueryResult] -> IO ()+        query a qrs = let results = deDup $ snd (search store (parseQuery a))+                      in forM_ qrs $ \qr -> case matchQR qr results of+                                              Success           -> putChar '.'+                                              ExpectedFailure   -> putChar 'o'+                                              _ -> errorIO $ "Searching for: " ++ show a+                                                           ++ "\nGot: " ++ show (take 5 results)+                                                           ++ "\n expected " ++ expected qr++    let hackage x = "https://hackage.haskell.org/package/" ++ x+    if sample then do+        "__prefix__" === "http://henry.com?too_long"+        "__suffix__" === "http://henry.com?too_long"+        "__infix__" === "http://henry.com?too_long"+        "Wife" === "http://eghmitchell.com/Mitchell.html#a_wife"+        completionTags store `testEq` ["set:all","set:sample-data","package:emily","package:henry"]+     else do+        "base" === hackage "base"+        "Prelude" === hackage "base/docs/Prelude.html"+        "map" === hackage "base/docs/Prelude.html#v:map"+        "map is:ping" === hackage "base/docs/Prelude.html#v:map"+        "map package:base" === hackage "base/docs/Prelude.html#v:map"+        noResults "map package:package-not-in-db"+        noResults "map module:Module.Not.In.Db"+        "True" === hackage "base/docs/Prelude.html#v:True"+        "Bool" === hackage "base/docs/Prelude.html#t:Bool"+        "String" === hackage "base/docs/Prelude.html#t:String"+        "Ord" === hackage "base/docs/Prelude.html#t:Ord"+        ">>=" === hackage "base/docs/Prelude.html#v:-62--62--61-"+        "sequen" === hackage "base/docs/Prelude.html#v:sequence"+        "foldl'" === hackage "base/docs/Prelude.html#v:foldl-39-" -- since base-4.20+        "Action package:shake" === "https://hackage.haskell.org/package/shake/docs/Development-Shake.html#t:Action"+        "Action package:shake set:stackage" === "https://hackage.haskell.org/package/shake/docs/Development-Shake.html#t:Action"+        "map -package:base" ==$ \x -> not $ "/base/" `isInfixOf` x+        "<>" === hackage "base/docs/Prelude.html#v:-60--62-"+        "Data.Set.insert" === hackage "containers/docs/Data-Set.html#v:insert"+        "Set.insert" === hackage "containers/docs/Data-Set.html#v:insert"+        "Prelude.mapM_" === hackage "base/docs/Prelude.html#v:mapM_"+        "Data.Complex.(:+)" === hackage "base/docs/Data-Complex.html#v::-43-"+        "\8801" === hackage "base-unicode-symbols/docs/Data-Eq-Unicode.html#v:-8801-"+        "\8484" === hackage "base-unicode-symbols/docs/Prelude-Unicode.html#t:-8484-"+        "copilot" === hackage "copilot"+        "supero" === hackage "supero"+        "set:stackage" === hackage "base"+        "author:Neil-Mitchell" === hackage "filepath"+        -- FIXME: "author:Neil-M" === hackage "filepath"+        -- FIXME: "Data.Se.insert" === hackage "containers/docs/Data-Set.html#v:insert"+        "set:-haskell-platform author:Neil-Mitchell" === hackage "safe"+        "author:Neil-Mitchell category:Javascript" === hackage "js-jquery"+        "( )" ==$ flip seq True -- used to segfault+        "( -is:exact) package:base=" ==$ flip seq True+        "(a -> b) -> [a] -> [b]" === hackage "base/docs/Prelude.html#v:map"+        "Ord a => [a] -> [a]" === hackage "base/docs/Data-List.html#v:sort"+        "ShakeOptions -> Int" === hackage "shake/docs/Development-Shake.html#v:shakeThreads"+        "is:module" === hackage "base/docs/Prelude.html"+        "visibleDataCons" === hackage "ghc/docs/GHC-Core-TyCon.html#v:visibleDataCons"+        "sparkle" === hackage "sparkle" -- library without Hoogle docs+        "weeder" === hackage "weeder" -- executable in Stackage+        "supero" === hackage "supero"++        query "(a -> [a]) -> [a] -> [a]"+            [ TopHit   ("concatMap" `inPackage` "base")+            , InTop 10 ("(=<<)" `inPackage` "base")+            , KnownFailure "" $ InTop 50 ("(>>=)" `inPackage` "base")+            ]+        query "[a] -> Maybe a"+            [ TopHit  ("listToMaybe" `inModule` "Data.Maybe")+            , InTop 10 ("headMay"     `inModule` "Safe")+            ]+        query "a -> [a]"+            [ InTop 10    ("repeat"    `inPackage` "base")+            , KnownFailure "" $ InTop 50    ("singleton" `inModule` "Util")+            , DoesNotFind ("head"      `inPackage` "base")+            , DoesNotFind ("last"      `inPackage` "base")+            , InTop 50    ("pure"      `inPackage` "base")+            , KnownFailure "" $ InTop 100   ("return"    `inPackage` "base")+            , KnownFailure "GitHub issue #267" $+                  ("pure" `inPackage` "base") `AppearsBefore` ("shrinkNothing" `inModule` "Test.QuickCheck")+            -- , InTop 10 ("pure"   `inPackage` "base")+            -- , InTop 10 ("return" `inPackage` "base")+            ]+        query "[a] -> a"+            [ InTop 10 ("head" `inPackage` "base")+            , InTop 10 ("last" `inPackage` "base")+            , DoesNotFind ("repeat" `inPackage` "base")+            ]+        query "[Char] -> Char"+            [ InTop 10 ("head" `inPackage` "base")+            , RanksBelow 10 ("mconcat" `inPackage` "base")+            ]+        query "a -> b"+            [ TopHit ("unsafeCoerce" `inModule` "Unsafe.Coerce")+            , DoesNotFind ("id" `inPackage` "base") -- see GitHub issue #180+            , KnownFailure "GitHub issue #268" $+                  InTop 20 ("coerce" `inModule` "Data.Coerce")+            , KnownFailure "GitHub issue #268" $+                  InTop 5   ("coerce" `inModule` "Data.Coerce")+            ]+        query "String -> (Char -> Maybe Char) -> Maybe String" -- c/o @ndrssmn+            [ KnownFailure "GitHub issue #266" $+                  InTop 10 ("traverse" `inPackage` "base")+            , KnownFailure "GitHub issue #266" $+                  InTop 10 ("mapM" `inPackage` "base")+            , KnownFailure "GitHub issue #266" $+                  InTop 10 ("forM" `inPackage` "base")+            ]+        query "a -> [(a,b)] -> b"+            [ KnownFailure "GitHub issue #267" $+                  TopHit  ("lookup" `inPackage` "base")+            , InTop 3 ("lookup" `inPackage` "base")+            , DoesNotFind ("zip" `inPackage` "base")+            ]+        query "[(a,b)] -> a -> b"+            [ KnownFailure "GitHub issue #267" $+                  TopHit ("lookup" `inPackage` "base")+            , InTop 3 ("lookup" `inPackage` "base")+            , DoesNotFind ("zip" `inPackage` "base")+            ]+        query "(a -> m b) -> t a -> m (t b)" -- see GitHub issue #218+            [ InTop 10 ("traverse" `inPackage` "base")+            , InTop 10 ("mapConcurrently" `inModule` "Control.Concurrent.Async.Lifted")+            , InTop 10 ("mapM" `inPackage` "base")+            , InTop 50 ("forM" `inPackage` "base")+            ]+        query "m (m a) -> m a" -- see GitHub issue #252+            [ TopHit ("join" `inPackage` "base")+            ]+        query "(a -> b -> c) -> (a -> b) -> a -> c"+            [ KnownFailure "GitHub issue #269" $+                  InTop 5 ("ap" `inPackage` "base")+            , KnownFailure "GitHub issue #269" $+                  InTop 5 ("(<*>)" `inPackage` "base")+            ]+        query "String -> Int"+            [ DoesNotFind ("cursorUpCode" `inPackage` "ansi-terminal")+            , KnownFailure "GitHub issue #266" $ InTop 20 ("length" `inPackage` "base")+            ]+        query "(a -> b) -> f a -> f b"+            [ TopHit ("fmap" `inPackage` "base")+            ]+        query "(a -> b) -> Maybe a -> Maybe b"+            [ InTop 3 ("fmap" `inPackage` "base")+            ]+        query "IO a -> m a"+            [ InTop 5 ("liftIO" `inPackage` "base")+            ]+        query "a -> m a" -- see GitHub issue #180+            [ InTop 20 ("pure" `inPackage` "base")+            , InTop 50 ("return" `inPackage` "base")+            , KnownFailure "GitHub issue #267" $+                  InTop 5 ("pure" `inPackage` "base")+            , KnownFailure "GitHub issue #267" $+                  InTop 3 ("return" `inPackage` "base")+            ]+        query "(a -> a) -> k -> Map k a -> Map k a" -- see GitHub issue #180+            [ TopHit ("adjust" `inPackage` "containers")+            ]+        query "Int -> Integer" -- see GitHub issue #127+            [ InTop 40 ("toInteger" `inPackage` "base")+            , KnownFailure "GitHub issue #127" $+                  TopHit ("toInteger" `inPackage` "base")+            ]+        query "Integer -> Int" -- see GitHub issue #127+            [ InTop 40 ("fromInteger" `inPackage` "base")+            , KnownFailure "GitHub issue #127" $+                  TopHit ("fromInteger" `inPackage` "base")+            ]+        query "[Parser a] -> Parser a" -- see GitHub issue #90+            [ KnownFailure "Todo" $ InTop 10 ("choice" `inPackage` "attoparsec")+            ]++        let tags = completionTags store+        let asserts b x = if b then putChar '.' else errorIO $ "Assertion failed, got False for " ++ x+        asserts ("set:haskell-platform" `elem` tags) "set:haskell-platform `elem` tags"+        asserts ("author:Neil-Mitchell" `elem` tags) "author:Neil-Mitchell `elem` tags"+        asserts ("package:uniplate" `elem` tags) "package:uniplate `elem` tags"+        asserts ("package:supero" `notElem` tags) "package:supero `notElem` tags"+++--------------------------------------------------------------------------------------------------+-- Test helpers++data ExpectedQueryResult+    = TopHit TargetMatcher+    | InTop Int TargetMatcher+    | RanksBelow Int TargetMatcher+    | DoesNotFind TargetMatcher+    | AppearsBefore TargetMatcher TargetMatcher+    | NoHits+    | KnownFailure String ExpectedQueryResult++expected :: ExpectedQueryResult -> String+expected = \case+    TopHit tm       -> showTM tm ++ " as first hit."+    InTop n tm      -> showTM tm ++ " in top " ++ show n ++ " hits."+    RanksBelow n tm -> showTM tm ++ " not in top " ++ show n ++ " hits."+    DoesNotFind tm  -> "to not match " ++ showTM tm ++ "."+    AppearsBefore tm tm' -> showTM tm ++ " to appear before " ++ showTM tm' ++ "."+    NoHits          -> "no results."+    KnownFailure why qr -> "to see a failure (" ++ why ++ "): \"" ++ expected qr ++ "\" But it succeeded!"++data TestResult+    = Success+    | Failure+    | ExpectedFailure+    | UnexpectedSuccess++matchQR :: ExpectedQueryResult -> [[Target]] -> TestResult+matchQR qr res = case qr of+    TopHit tm        -> success $ any (any (runTargetMatcher tm)) $ take 1 res+    InTop n tm       -> success $ any (any (runTargetMatcher tm)) $ take n res+    RanksBelow n tm  -> success $ any (any (runTargetMatcher tm)) $ drop n res+    DoesNotFind tm   -> success $ not $ any (any (runTargetMatcher tm)) res+    AppearsBefore tm tm' -> success $ ( (<) <$> matchIdx tm <*> matchIdx tm' ) == Just True+    NoHits           -> success $ null res+    KnownFailure _ qr' -> case matchQR qr' res of+        Success           -> UnexpectedSuccess+        Failure           -> ExpectedFailure+        ExpectedFailure   -> Failure+        UnexpectedSuccess -> Failure+  where+    success p = if p then Success else Failure+    matchIdx tm = fmap fst $ find (runTargetMatcher tm . snd) (zipFrom 0 $ concat res)++data TargetMatcher+    = MatchFunctionInModule  String String+    | MatchFunctionInPackage String String++showTM :: TargetMatcher -> String+showTM = \case+    MatchFunctionInModule  f m -> m ++ "'s " ++ f+    MatchFunctionInPackage f p -> f ++ " from package " ++ p++runTargetMatcher :: TargetMatcher -> Target -> Bool+runTargetMatcher matcher Target{..} = case matcher of+    MatchFunctionInModule f m ->+        Just m == fmap fst targetModule+        && f `isPrefixOf` unHTML targetItem+    MatchFunctionInPackage f m ->+        Just m == fmap fst targetPackage+        && f `isPrefixOf` unHTML targetItem++inModule :: String -> String -> TargetMatcher+inModule = MatchFunctionInModule++inPackage :: String -> String -> TargetMatcher+inPackage = MatchFunctionInPackage++-- Group duplicated targets (e.g. re-exports) together.+deDup :: [Target] -> [[Target]]+deDup tgts = Map.elems (Map.fromList $ Map.elems tgtMap)+  where+    tgtMap :: Map.Map Target (Int, [Target])+    tgtMap = Map.fromListWith (\(n, ts) (n', ts') -> (min n n', ts ++ ts'))+             $ zipWithFrom (\n t -> (simple t, (n, [t]))) 0 tgts++    simple :: Target -> Target+    simple t = t { targetURL = "", targetPackage = Nothing, targetModule = Nothing }
+ src/Action/Server.hs view
@@ -0,0 +1,309 @@+{-# LANGUAGE ViewPatterns, TupleSections, RecordWildCards, ScopedTypeVariables, PatternGuards #-}+{-# LANGUAGE OverloadedStrings #-}++module Action.Server(actionServer, actionReplay, action_server_test_, action_server_test) where++import Data.List.Extra+import System.FilePath+import Control.Exception+import Control.Exception.Extra+import Control.DeepSeq+import System.Directory+import Text.Blaze+import Text.Blaze.Renderer.Utf8+import qualified Text.Blaze.XHtml5 as H+import qualified Text.Blaze.XHtml5.Attributes as H+import Data.Tuple.Extra+import qualified Language.Javascript.JQuery as JQuery+import qualified Language.Javascript.Flot as Flot+import Data.Version+import Paths_hoogle+import Data.Maybe+import Control.Monad.Extra+import Text.Read+import System.IO.Extra+import General.Str+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.Map as Map+import System.Time.Extra+import Data.Time.Clock+import Data.Time.Calendar+import System.IO.Unsafe+import Numeric.Extra+import System.Info.Extra++import Output.Tags+import Query+import Input.Item+import General.Util+import General.Web+import General.Store+import General.Template+import General.Log+import Action.Search+import Action.CmdLine+import Control.Applicative+import Data.Monoid+import Prelude++import qualified Data.Aeson as JSON++actionServer :: CmdLine -> IO ()+actionServer cmd@Server{..} = do+    -- so I can get good error messages+    hSetBuffering stdout LineBuffering+    hSetBuffering stderr LineBuffering+    putStrLn $ "Server started on port " ++ show port+    putStr "Reading log..." >> hFlush stdout+    time <- offsetTime+    log <- logCreate (if logs == "" then Left stdout else Right logs) $+        \x -> BS.pack "hoogle=" `BS.isInfixOf` x && not (BS.pack "is:ping" `BS.isInfixOf` x)+    putStrLn . showDuration =<< time+    evaluate spawned+    dataDir <- maybe getDataDir pure datadir+    haddock <- maybe (pure Nothing) (fmap Just . canonicalizePath) haddock+    withSearch database $ \store ->+        server log cmd $ replyServer log local links haddock store cdn home (dataDir </> "html") scope++actionReplay :: CmdLine -> IO ()+actionReplay Replay{..} = withBuffering stdout NoBuffering $ do+    src <- readFile logs+    let qs = catMaybes [readInput url | _:ip:_:url:_ <- map words $ lines src, ip /= "-"]+    (t,_) <- duration $ withSearch database $ \store -> do+        log <- logNone+        dataDir <- getDataDir+        let op = replyServer log False False Nothing store "" "" (dataDir </> "html") scope+        replicateM_ repeat_ $ forM_ qs $ \x -> do+            res <- op x+            evaluate $ rnf res+            putChar '.'+    putStrLn $ "\nTook " ++ showDuration t ++ " (" ++ showDuration (t / intToDouble (repeat_ * length qs)) ++ ")"++{-# NOINLINE spawned #-}+spawned :: UTCTime+spawned = unsafePerformIO getCurrentTime++replyServer :: Log -> Bool -> Bool -> Maybe FilePath -> StoreRead -> String -> String -> FilePath -> String -> Input -> IO Output+replyServer log local links haddock store cdn home htmlDir scope Input{..} = case inputURL of+    -- without -fno-state-hack things can get folded under this lambda+    [] -> do+        let grabBy name = [x | (a,x) <- inputArgs, name a, x /= ""]+            grab name = grabBy (== name)+            grabInt name def = fromMaybe def $ readMaybe =<< listToMaybe (grab name) :: Int++        let qScope = let xs = grab "scope" in [scope | null xs && scope /= ""] ++ xs+        let qSearch = grabBy (`elem` ["hoogle","q"])+        let qSource = qSearch ++ filter (/= "set:stackage") qScope+        let q = concatMap parseQuery qSource+        let (q2, results) = search store q+        let body = showResults local links haddock (filter ((/= "mode") . fst) inputArgs) q2 $+                dedupeTake 25 (\t -> t{targetURL="",targetPackage=Nothing, targetModule=Nothing}) results+        case lookup "mode" inputArgs of+            Nothing | qSource /= [] -> fmap OutputHTML $ templateRender templateIndex+                        [("tags", html $ tagOptions qScope)+                        ,("body", html body)+                        ,("title", text $ unwords qSource ++ " - Hoogle")+                        ,("search", text $ unwords qSearch)+                        ,("robots", text $ if any isQueryScope q then "none" else "index")]+                    | otherwise -> OutputHTML <$> templateRender templateHome []+            Just "body" -> OutputHTML <$> if null qSource then templateRender templateEmpty [] else templateRender (html body) []+            Just "json" ->+              let -- 1 means don't drop anything, if it's less than 1 ignore it+                  start :: Int+                  start = max 0 $ grabInt "start" 1 - 1+                  -- by default it returns 100 entries+                  count :: Int+                  count = min 500 $ grabInt "count" 100+                  filteredResults = take count $ drop start results+              in case lookup "format" inputArgs of+                Just "text" -> pure $ OutputJSON $ JSON.toEncoding $ map unHTMLTarget filteredResults+                Just f -> pure $ OutputFail $ lbstrPack $ "Format mode " ++ f ++ " not (currently) supported"+                Nothing -> pure $ OutputJSON $ JSON.toEncoding filteredResults+            Just m -> pure $ OutputFail $ lbstrPack $ "Mode " ++ m ++ " not (currently) supported"+    ["plugin","jquery.js"] -> OutputFile <$> JQuery.file+    ["plugin","jquery.flot.js"] -> OutputFile <$> Flot.file Flot.Flot+    ["plugin","jquery.flot.time.js"] -> OutputFile <$> Flot.file Flot.FlotTime++    ["canary"] -> do+        now <- getCurrentTime+        summ <- logSummary log+        let errs = sum [summaryErrors | Summary{..} <- summ, summaryDate >= pred (utctDay now)]+        let alive = fromRational $ toRational $ (now `diffUTCTime` spawned) / (24 * 60 * 60)+        pure $ (if errs == 0 && alive < 1.5 then OutputText else OutputFail) $ lbstrPack $+            "Errors " ++ (if errs == 0 then "good" else "bad") ++ ": " ++ show errs ++ " in the last 24 hours.\n" +++            "Updates " ++ (if alive < 1.5 then "good" else "bad") ++ ": Last updated " ++ showDP 2 alive ++ " days ago.\n"++    ["log"] -> do+        OutputHTML <$> templateRender templateLog []+    ["log.js"] -> do+        log <- displayLog <$> logSummary log+        OutputJavascript <$> templateRender templateLogJs [("data",html $ H.preEscapedString log)]+    ["stats"] -> do+        stats <- getStatsDebug+        pure $ case stats of+            Nothing -> OutputFail $ lbstrPack "GHC Statistics is not enabled, restart with +RTS -T"+            Just x -> OutputText $ lbstrPack x+    "haddock":xs | Just x <- haddock -> do+        let file = intercalate "/" $ x:xs+        pure $ OutputFile $ file ++ (if hasTrailingPathSeparator file then "index.html" else "")+    "file":xs | local -> do+        let x = ['/' | not isWindows] ++ intercalate "/" (dropWhile null xs)+        let file = x ++ (if hasTrailingPathSeparator x then "index.html" else "")+        if takeExtension file /= ".html" then+            pure $ OutputFile file+         else do+            src <- readFile file+            -- Haddock incorrectly generates file:// on Windows, when it should be file:///+            -- so replace on file:// and drop all leading empty paths above+            pure $ OutputHTML $ lbstrPack $ replace "file://" "/file/" src+    xs ->+        pure $ OutputFile $ joinPath $ htmlDir : xs+    where+        html = templateMarkup+        text = templateMarkup . H.string++        tagOptions sel = mconcat [H.option Text.Blaze.!? (x `elem` sel, H.selected "selected") $ H.string x | x <- completionTags store]+        params =+            [("cdn", text cdn)+            ,("home", text home)+            ,("jquery", text $ if null cdn then "plugin/jquery.js" else "https:" ++ JQuery.url)+            ,("version", text $ showVersion version ++ " " ++ showUTCTime "%Y-%m-%d %H:%M" spawned)]+        templateIndex = templateFile (htmlDir </> "index.html") `templateApply` params+        templateEmpty = templateFile (htmlDir </>  "welcome.html")+        templateHome = templateIndex `templateApply` [("tags",html $ tagOptions []),("body",templateEmpty),("title",text "Hoogle"),("search",text ""),("robots",text "index")]+        templateLog = templateFile (htmlDir </> "log.html") `templateApply` params+        templateLogJs = templateFile (htmlDir </> "log.js") `templateApply` params+++dedupeTake :: Ord k => Int -> (v -> k) -> [v] -> [[v]]+dedupeTake n key = f [] Map.empty+    where+        -- map is Map k [v]+        f res mp xs | Map.size mp >= n || null xs = map (reverse . (Map.!) mp) $ reverse res+        f res mp (x:xs) | Just vs <- Map.lookup k mp = f res (Map.insert k (x:vs) mp) xs+                        | otherwise = f (k:res) (Map.insert k [x] mp) xs+            where k = key x+++showResults :: Bool -> Bool -> Maybe FilePath -> [(String, String)] -> [Query] -> [[Target]] -> Markup+showResults local links haddock args query results = do+    H.h1 $ renderQuery query+    when (null results) $ H.p "No results found"+    forM_ results $ \is@(Target{..}:_) -> do+        H.div ! H.class_ "result" $ do+            H.div ! H.class_ "ans" $ do+                H.a ! H.href (H.stringValue $ showURL local haddock targetURL) $+                    displayItem query targetItem+                when links $+                    whenJust (useLink is) $ \link ->+                        H.div ! H.class_ "links" $ H.a ! H.href (H.stringValue link) $ "Uses"+            H.div ! H.class_ "from" $ showFroms local haddock is+            H.div ! H.class_ "doc newline shut" $ H.preEscapedString targetDocs+    H.ul ! H.id "left" $ -- if there's already a scope query we don't show subquery links because bots will get lost in a maze of links.+        if (any isQueryScope query) then pure () else do+            H.li $ H.b "Packages"+            mconcat [H.li $ f cat val | (cat,val) <- itemCategories $ concat results, QueryScope True cat val `notElem` query]++    where+        useLink :: [Target] -> Maybe String+        useLink [t] | isNothing $ targetPackage t =+            Just $ "https://packdeps.haskellers.com/reverse/" ++ extractName (targetItem t)+        useLink _ = Nothing++        add x = ("?" ++) $ intercalate "&" $ map (joinPair "=") $+            case break ((==) "hoogle" . fst) args of+                (a,[]) -> a ++ [("hoogle", escapeURL x)]+                (a,(_,x1):b) -> a ++ [("hoogle", escapeURL $ x1 ++ " " ++ x)] ++ b++        f cat val = do+            H.a ! H.class_" minus" ! H.href (H.stringValue $ add $ "-" ++ cat ++ ":" ++ val) $ ""+            H.a ! H.class_ "plus"  ! H.href (H.stringValue $ add $        cat ++ ":" ++ val) $+                H.string $ (if cat == "package" then "" else cat ++ ":") ++ val+++-- find the <span class=name>X</span> bit+extractName :: String -> String+extractName x+    | Just (_, x) <- stripInfix "<span class=name>" x+    , Just (x, _) <- stripInfix "</span>" x+    = unHTML x+extractName x = x+++itemCategories :: [Target] -> [(String,String)]+itemCategories xs =+    [("is","exact")] +++    [("is","package") | any ((==) "package" . targetType) xs] +++    [("is","module")  | any ((==) "module"  . targetType) xs] +++    nubOrd [("package",p) | Just (p,_) <- map targetPackage xs]++showFroms :: Bool -> Maybe FilePath -> [Target] -> Markup+showFroms local haddock xs = mconcat $ intersperse ", " $ flip map pkgs $ \p ->+    let ms = filter ((==) p . targetPackage) xs+    in mconcat $ intersperse " " [H.a ! H.href (H.stringValue $ showURL local haddock b) $ H.string a | (a,b) <- catMaybes $ p : map remod ms]+    where+        remod Target{..} = do (a,_) <- targetModule; pure (a,targetURL)+        pkgs = nubOrd $ map targetPackage xs++showURL :: Bool -> Maybe FilePath -> URL -> String+showURL _ (Just _) x = "haddock/" ++ dropPrefix "file:///" x+showURL True _ (stripPrefix "file:///" -> Just x) = "file/" ++ x+showURL _ _ x = x+++-------------------------------------------------------------+-- DISPLAY AN ITEM (bold keywords etc)+++displayItem :: [Query] -> String -> Markup+displayItem = highlightItem H.string H.preEscapedString H.string (H.b . H.string)++action_server_test_ :: IO ()+action_server_test_ = do+    testing "Action.Server.displayItem" $ do+        let expand = replace "{" "<b>" . replace "}" "</b>" . replace "<s0>" "" . replace "</s0>" ""+            contract = replace "{" "" . replace "}" ""+        let q === s | LBS.unpack (renderMarkup $ displayItem (parseQuery q) (contract s)) == expand s = putChar '.'+                    | otherwise = errorIO $ show (q,s,renderMarkup $ displayItem (parseQuery q) (contract s))+        "test" === "<s0>my{Test}</s0> :: Int -&gt; test"+        "new west" === "<s0>{newest}_{new}</s0> :: Int"+        "+*" === "(<s0>{+*}&amp;</s0>) :: Int"+        "+<" === "(<s0>&gt;{+&lt;}</s0>) :: Int"+        "foo" === "<i>data</i> <s0>{Foo}d</s0>"+        "foo" === "<i>type</i> <s0>{Foo}d</s0>"+        "foo" === "<i>type family</i> <s0>{Foo}d</s0>"+        "foo" === "<i>module</i> Foo.Bar.<s0>F{Foo}</s0>"+        "foo" === "<i>module</i> <s0>{Foo}o</s0>"++action_server_test :: Bool -> FilePath -> IO ()+action_server_test sample database = do+    testing "Action.Server.replyServer" $ withSearch database $ \store -> do+        log <- logNone+        dataDir <- getDataDir+        let check p q = do+                OutputHTML (lbstrUnpack -> res) <- replyServer log False False Nothing store "" "" (dataDir </> "html") "" (Input [] [("hoogle",q)])+                if p res then putChar '.' else fail $ "Bad substring: " ++ res+        let q === want = check (want `isInfixOf`) q+        let q /== want = check (not . isInfixOf want) q+        "<test" /== "<test"+        "&test" /== "&test"+        if sample then+            "Wife" === "<b>type family</b>"+         else do+            "<>" === "<span class=name>(<b>&lt;&gt;</b>)</span>"+            "filt" === "<span class=name><b>filt</b>er</span>"+            "True" === "https://hackage.haskell.org/package/base/docs/Prelude.html#v:True"+++-------------------------------------------------------------+-- ANALYSE THE LOG+++displayLog :: [Summary] -> String+displayLog xs = "[" ++ intercalate "," (map f xs) ++ "]"+    where+        f Summary{..} = "{date:" ++ show (showGregorian summaryDate) +++                        ",users:" ++ show summaryUsers ++ ",uses:" ++ show summaryUses +++                        ",slowest:" ++ show summarySlowest ++ ",average:" ++ show (fromAverage summaryAverage) +++                        ",errors:" ++ show summaryErrors ++ "}"
+ src/Action/Test.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE TupleSections, RecordWildCards, ScopedTypeVariables #-}++module Action.Test(actionTest) where++import Query+import Action.CmdLine+import Action.Search+import Action.Server+import Action.Generate+import General.Util+import General.Web+import Input.Item+import Input.Haddock+import System.IO.Extra++import Control.Monad+import Output.Items+import Control.DeepSeq+import Control.Exception+++actionTest :: CmdLine -> IO ()+actionTest Test{..} = withBuffering stdout NoBuffering $ withTempFile $ \sample -> do+    putStrLn "Code tests"+    general_util_test+    general_web_test+    input_haddock_test+    query_test+    action_server_test_+    item_test+    putStrLn ""++    putStrLn "Sample database tests"+    actionGenerate defaultGenerate{database=sample, local_=["misc/sample-data"]}+    action_search_test True sample+    unless disable_network_tests $ action_server_test True sample+    putStrLn ""++    unless disable_network_tests $ do+        putStrLn "Haskell.org database tests"+        action_search_test False database+        action_server_test False database++        when deep $ withSearch database $ \store -> do+            putStrLn "Deep tests"+            let xs = map targetItem $ listItems store+            evaluate $ rnf xs+            putStrLn $ "Loaded " ++ show (length xs) ++ " items"
− src/CmdLine/All.hs 
@@ -1,117 +0,0 @@-{-|-    Parse a query, that may have come from either a CGI variable-    or the command line arguments.--    Need to return the following pieces of information:--    * Was there a query, or was nothing entered--    * Are you wanting to operate in Web mode or Command Line mode. Adding a-    Web parameter to Command Line gives you Web mode.--    * Which flags were specified, and which were erroneous.--}-module CmdLine.All(-    cmdLine, cmdLineWeb, CmdLine(..), isWebCmdLine,-    module CmdLine.Load-    ) where--import General.Base-import General.System-import System.FilePath-import CmdLine.Type-import CmdLine.Load-import General.Web-import System.Console.CmdArgs-import Hoogle-import Hoogle.Query.Type-import GHC.Conc(numCapabilities)-import Paths_hoogle-import Safe--------------------------------------------------------------------------- CMDLINE EXPANSION--cmdLineExpand :: CmdLine -> IO CmdLine-cmdLineExpand x@Search{} = do-    db <- expandDatabases $ databases x-    return x { queryText = s-               , queryParsed =-                   (\q -> q { exactSearch =-                                   if exact x-                                   then Just UnclassifiedItem-                                   else Nothing })-                   `fmap` parseQuery Haskell s-               , databases = db-               }-    where s = unwords $ queryChunks x---cmdLineExpand x@Server{} = do-    dat <- getDataDir-    db <- expandDatabases $ databases x-    let res = if null $ resources x then dat </> "resources" else resources x-    return x{databases=db, resources=res}--cmdLineExpand x@Test{} = do-    dat <- getDataDir-    let files1 = if null $ testFiles x then [dat </> "tests.txt"] else testFiles x-        files2 = [dat </> "examples.txt" | example x]-    return x{testFiles = files1 ++ files2}--cmdLineExpand x@Rank{} = do-    file <- if null $ srcfile x then fmap (</> "rank.txt") getDataDir else return $ srcfile x-    return x{srcfile=file}--cmdLineExpand x@Data{} = do-    dir <- if null $ datadir x then fmap (</> "databases") getDataDir else return $ datadir x-    let thrd = if threads x == 0 then numCapabilities else threads x-    loc <- if all null (local x) && not (null $ local x) then guessLocal else return $ local x-    return x{datadir=dir, threads=thrd, local=loc}--cmdLineExpand x@Convert{} =-  return x{haddock = haddock x || isJust (doc x),-    outfile = if null (outfile x) then replaceExtension (srcfile x) "hoo" else outfile x}--cmdLineExpand x = return x---expandDatabases x = do-    d <- getDataDir-    return $ x ++ [d </> "databases"]---guessLocal = do-    ghc <- findExecutable "ghc"-    home <- getHomeDirectory-    lib <- getLibDir-    let xs = [takeDirectory (takeDirectory lib) </> "doc" {- Windows, installed with Cabal -}  ] ++-             [takeDirectory (takeDirectory ghc) </> "doc/html/libraries" | Just ghc <- [ghc] {- Windows, installed by GHC -} ] ++-             [home </> ".cabal/share/doc" {- Linux -} ]-    filterM doesDirectoryExist xs--------------------------------------------------------------------------- QUERY CONVERSION--cmdLine :: IO CmdLine-cmdLine = do-    r <- cgiArgs-    case r of-        Just y -> cmdLineWeb y-        Nothing -> cmdLineArgs---cmdLineArgs :: IO CmdLine-cmdLineArgs = cmdLineExpand =<< cmdArgsRun cmdLineMode---cmdLineWeb :: [(String,String)] -> IO CmdLine-cmdLineWeb args = cmdLineExpand $ blankSearch-        {web=Just $ fromMaybe "web" $ ask ["mode"]-        ,start=askInt ["start"], count=askInt ["count"]-        ,exact=fromMaybe 0 (askInt ["exact"]) == 1-        ,queryChunks = mapMaybe ask [["prefix"],["q","hoogle"],["suffix"]]}-    where ask x = listToMaybe [b | (a,b) <- args, a `elem` x]-          askInt x = readMay =<< ask x
− src/CmdLine/Load.hs 
@@ -1,28 +0,0 @@--module CmdLine.Load(loadQueryDatabases, availableDatabases) where--import Hoogle-import General.Base-import General.Util-import General.System-import System.FilePath----- | Given a list of search directories, and a query, load the databases you---   need, and return a list of those that you couldn't find-loadQueryDatabases :: [FilePath] -> Query -> IO ([String],Database)-loadQueryDatabases paths q = do-    let findFile = findM doesFileExist-    let xs = queryDatabases q-    fmap (second mconcat . partitionEithers) $ forM xs $ \x -> do-        r <- findFile [p </> x <.> "hoo" | p <- paths]-        case r of-            Nothing -> return $ Left x-            Just x -> fmap Right $ loadDatabase x---availableDatabases :: [FilePath] -> IO [String]-availableDatabases xs = fmap (sortBy compareString . nub . concat) $ forM xs $ \x -> do-    b <- doesDirectoryExist x-    ys <- if b then getDirectoryContents x else return []-    return [dropExtension y | y <- ys, takeExtension y == ".hoo"]
− src/CmdLine/Type.hs 
@@ -1,136 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# OPTIONS_GHC -fno-warn-missing-fields -fno-cse #-}--module CmdLine.Type(-    CmdLine(..), cmdLineMode, isWebCmdLine, blankSearch-    ) where--import System.Console.CmdArgs-import Paths_hoogle(version)-import Data.Version(showVersion)-import Hoogle---isWebCmdLine Search{web=Just _} = True-isWebCmdLine Server{} = True-isWebCmdLine _ = False---data CmdLine-    = Search-        {color :: Bool-        ,link :: Bool-        ,info :: Bool-        ,exact :: Bool-        ,databases :: [FilePath]-        ,start :: Maybe Int-        ,count :: Maybe Int-        ,web :: Maybe String-        ,repeat_ :: Int-        ,queryChunks :: [String]-        ,queryParsed :: Either ParseError Query-        ,queryText :: String-        }-    | Data {-          hackage    :: String-        , redownload :: Bool-        , rebuild :: Bool-        , local :: [String]-        , datadir :: FilePath-        , threads :: Int-        , actions :: [String]-        , nodownload :: Bool-        }-    | Server {port :: Int, local_ :: Bool, databases :: [FilePath], resources :: FilePath, dynamic :: Bool, template :: [FilePath]}-    | Combine {srcfiles :: [FilePath], outfile :: String}-    | Convert {-          hackage :: String-        , srcfile :: String-        , outfile :: String-        , doc :: Maybe String-        , merge :: [String]-        , haddock :: Bool}-    | Log {logfiles :: [FilePath]}-    | Test {testFiles :: [String], example :: Bool}-    | Dump {database :: String, section :: [String]}-    | Rank {srcfile :: FilePath}-      deriving (Data,Typeable,Show)--emptyParseError = ParseError 0 0 "" $ Str ""-blankSearch = Search False False False False [] Nothing Nothing Nothing 1 [] (Left emptyParseError) ""--cmdLineMode = cmdArgsMode $ modes [search_ &= auto,data_,server,combine,convert,test,dump,rank,log_]-    &= verbosity &= program "hoogle"-    &= summary ("Hoogle v" ++ showVersion version ++ ", (C) Neil Mitchell 2004-2012\nhttp://haskell.org/hoogle")--search_ = Search-    {web = def &= typ "MODE" &= opt "web" &= help "Operate as a web tool"-    ,start = def &= help "Start displaying results from this point on (1 based)"-    ,count = def &= name "n" &= help "Maximum number of results to return"-    ,queryChunks = def &= args &= typ "QUERY"-    ,info = def &= help "Give extended information about the first result"-    ,exact = def &= help "Match names exactly when searching"-    ,link = def &= help "Give URL's for each result"-    ,color = def &= name "colour" &= help "Use colored output (requires ANSI terminal)"-    ,databases = ["."] &= typDir &= help "Directories to search for databases"-    ,repeat_ = 1 &= help "Run the search multiple times (for benchmarking)"-    ,queryParsed = Left emptyParseError &= ignore-    ,queryText = "" &= ignore-    } &= help "Perform a search"--test = Test-    {testFiles = def &= typFile &= args-    ,example = def &= help "Test the full examples"-    } &= help "Run tests"--server = Server-    {port = 80 &= typ "INT" &= help "Port number"-    ,resources = "" &= typDir &= help "Directory to use for resources (images, CSS etc)"-    ,local_ = def &= help "Rewrite and serve file: links (potential security hole)"-    ,dynamic = def &= name "x" &= help "Allow resource files to change during execution"-    ,template = def &= typFile &= help "Template files to use instead of default definitions"-    } &= help "Start a Hoogle server"--dump = Dump-    {database = def &= argPos 0 &= typ "DATABASE"-    ,section = def &= args &= typ "SECTION"-    } &= help "Dump sections of a database to stdout"--rank = Rank-    {srcfile = def &= argPos 0 &= typ "RANKFILE" &= opt ""-    } &= help "Generate ranking information"--combine = Combine-    {srcfiles = def &= args &= typ "DATABASE"-    ,outfile = "default.hoo" &= typFile &= help "Output file (defaults to default.hoo)"-    } &= help "Combine multiple databases into one"--convert = Convert-    {hackage = "http://hackage.haskell.org/" &= typ "URL" &= help "Hackage instance to target"-    ,srcfile = def &= argPos 0 &= typ "INPUT"-    ,outfile = def &= argPos 1 &= typ "DATABASE" &= opt ""-    ,doc = def &= typDir &= help "Path to the root of local or Hackage documentation for the package (implies --haddock)"-    ,merge = def &= typ "DATABASE" &= help "Merge other databases"-    ,haddock = def &= help "Apply haddock-specific hacks"-    } &= help "Convert an input file to a database"--data_ = Data-    {datadir = def &= typDir &= help "Database directory"-    ,hackage    = "http://hackage.haskell.org/" &= typ "URL" &= help "Hackage instance to target"-    ,redownload = def &= help "Redownload all files from the web"-    ,rebuild = def &= help "Rebuild everything"-    ,threads = 1 &= typ "INT" &= name "j" &= help "Number of threads to use"-    ,actions = def &= args &= typ "RULE"-    ,local = def &= opt "" &= typ "FILEPATH" &= help "Use local documentation if available"-    ,nodownload = def &= explicit &= name "no-download" &= help "Abort if any of the needed source files are missing, instead of downloading them"-    } &= help "Generate Hoogle databases"-      &= details ["Each argument should be the name of a database you want to generate"-                 ,"optionally followed by which files to combine. Common options:"-                 ,""-                 ,"  data default -- equivalent to no arguments"-                 ,"  data all"-                 ]--log_ = Log-    {logfiles = def &= args &= typ "LOGFILE"-    } &= help "Analyse log files"
− src/Console/All.hs 
@@ -1,88 +0,0 @@--module Console.All(action) where--import CmdLine.All-import Recipe.All-import Recipe.Haddock-import Console.Log-import Console.Search-import Console.Test-import Console.Rank-import General.Base-import General.System-import General.Web-import System.FilePath-import Hoogle-import Hoogle.Type.All---action :: CmdLine -> IO ()--action x@Search{repeat_=i} | i /= 1 = replicateM_ i $ action x{repeat_=1}--action x@Search{queryParsed = Left err} =-    exitMessage ["Parse error:", "  " ++ showTag (parseInput err)-                ,replicate (columnNo err) ' ' ++ " ^"-                ,errorMessage err]-    where showTag = if color x then showTagANSI else showTagText---action (Test files _) = do-    testPrepare-    fails <- fmap sum $ mapM (testFile action) files-    if fails == 0 then putStrLn "Tests passed" else do-        putStrLn $ "TEST FAILURES (" ++ show fails ++ ")"-        exitFailure--action (Rank file) = rank file--action x@Data{} = recipes x--action (Log files) = logFiles files--action (Convert url from to doc merge haddock) = do-    when (any isUpper $ takeBaseName to) $ putStrLn $ "Warning: Hoogle databases should be all lower case, " ++ takeBaseName to-    putStrLn $ "Converting " ++ from-    src <- readFileUtf8 from-    convert url merge (takeBaseName from) to $ unlines $ addLocalDoc doc (lines src)-    where-      addLocalDoc :: Maybe FilePath -> [String] -> [String]-      addLocalDoc doc = if haddock-                          then haddockHacks $ addDoc doc-                          else id--      addDoc :: Maybe FilePath -> Maybe URL-      addDoc = addGhcDoc . fmap (\x -> if "http://" `isPrefixOf` x then x else filePathToURL $ x </> "index.html")--      addGhcDoc :: Maybe URL -> Maybe URL-      addGhcDoc x = if isNothing x && takeBaseName from == "ghc"-                      then Just "http://www.haskell.org/ghc/docs/latest/html/libraries/ghc/"-                      else x---action (Combine from to) = do-    putStrLn $ "Combining " ++ show (length from) ++ " databases"-    mergeDatabase from to--action (Dump file sections) = do-    d <- loadDatabase file-    putStrLn $ "File: " ++ file-    putStr $ showDatabase d $ if null sections then Nothing else Just sections--action q@Search{} | fromRight (queryParsed q) == mempty =-    exitMessage ["No query entered"-                ,"Try --help for command line options"]--action q@Search{} = actionSearch q (fromRight $ queryParsed q)------ convert a single database-convert :: HackageURL -> [FilePath] -> String -> FilePath -> String -> IO ()-convert url deps x out src = do-    deps2 <- filterM doesFileExist deps-    when (deps /= deps2) $ putStrLn $ "Warning: " ++ x ++ " doesn't know about dependencies on " ++ unwords (deps \\ deps2)-    dbs <- mapM loadDatabase deps2-    putStr $ "Converting " ++ x ++ "... "-    err <- createDatabase url Haskell dbs src out-    putStrLn "done"-    unless (null err) $ putStrLn $ "Skipped " ++ show (length err) ++ " warnings in " ++ x
− src/Console/Log.hs 
@@ -1,203 +0,0 @@-{-# LANGUAGE PatternGuards, RecordWildCards, ScopedTypeVariables #-}---- | Analyse the log files. It's a three stage process.---   1, parse each line separately.---   2, collapse searches done between lines (instant, ajax, suggest)---   3, draw overall statistics-module Console.Log(logFiles) where--import General.Base-import qualified Data.ByteString.Lazy.Char8 as LBS-import qualified Data.Map as Map--logFiles :: [FilePath] -> IO ()-logFiles xs = do-    es <- mapM readEntries xs-    print $ mconcat $ map (stats . groupEntries) es-------------------------------------------------------------------------- STATISTICS--data Stats = Stats-    {hits :: !Int-    ,searches :: !Int-    ,common :: !(Map.Map LBString Int)-    }--instance Show Stats where-    show Stats{..} = unlines-        ["Hits:      " ++ show hits-        ,"Searches:  " ++ show searches-        ,"Unique:    " ++ show (Map.size common)-        ,"Top:       " ++ fromList "" (map (LBS.unpack . fst) top)-        ]-        where-            top = take 20 $ sortBy (comparing $ negate . snd) $ Map.toList common---instance Monoid Stats where-    mempty = Stats 0 0 Map.empty-    mappend (Stats x1 x2 x3) (Stats y1 y2 y3) = Stats (x1+y1) (x2+y2) (Map.unionWith (+) x3 y3)--stats :: [Entry] -> Stats-stats = foldl' f mempty-    where-        f s@Stats{..} Entry{..} = s-            {hits = 1 + hits-            ,searches = (if LBS.null search then 0 else 1) + searches-            ,common = if LBS.null search then common else Map.insertWith' (+) search 1 common-            }--------------------------------------------------------------------------- GROUP ENTRIES--groupEntries :: [Entry] -> [Entry]-groupEntries = id--------------------------------------------------------------------------- READ ENTRIES--data Entry = Entry-    {search :: LBString -- the search performed, "" for blank-    ,extra :: [(LBString,LBString)] -- extra parameters-    ,date :: Maybe (Int,Int,Int) -- date the search was performed-    ,time :: Maybe (Int,Int,Int) -- time the search was performed-    ,unique :: Maybe String -- maybe a uniquely identifying string-    ,instant :: Maybe Int -- number of times you hit with instant for this query-    ,suggest :: Maybe Int -- number of times you hit with suggest for this query-    } deriving (Eq, Show)--entry = Entry LBS.empty [] Nothing Nothing Nothing Nothing Nothing---readEntries :: FilePath -> IO [Entry]-readEntries x = do-    src <- LBS.readFile x-    return $ mapMaybe readEntry $ LBS.lines src---qstr = map LBS.pack ["","q","hoogle"]--readEntry :: LBString -> Maybe Entry---- log format v1-readEntry x-    | Just ('[',x) <- LBS.uncons x-    = do y <- readList x-         let (a,b) = partition (flip elem qstr . fst) y-         return entry{search=fromList LBS.empty $ map snd a, extra = b}-    where-        readList x = do-            ('(',x) <- LBS.uncons x-            (a,x) <- readShowString x-            (',',x) <- LBS.uncons x-            (b,x) <- readShowString x-            (')',x) <- LBS.uncons x-            case LBS.uncons x of-                Just (',',x) -> do-                    ys <- readList x-                    return $ (a,b):ys-                Just (']',x) -> do-                    return [(a,b)]-                _ -> Nothing---- log format v2-readEntry o@x-    | LBS.length x > 10 && LBS.index x 10 == ' '-    = do (d,x) <- readDate x-         (' ',x) <- LBS.uncons x-         (s,x) <- readShowString x-         args <- readArgs $ LBS.dropWhile isSpace x-         return entry{search = s, date = Just d,-                extra = filter (flip notElem qstr . fst) args}-    where-        readArgs x-            | Just ('?',x) <- LBS.uncons x = do-              (a,x) <- return $ LBS.break (== '=') x-              ('=',x) <- LBS.uncons x-              (b,x) <- readQuoteString x-              x <- return $ LBS.dropWhile isSpace x-              ys <- readArgs x-              return $ (a,b) : ys-            | otherwise = Just []-    ---- log format v3-readEntry x-    | LBS.length x > 10 && LBS.index x 10 == 'T'-    = do ((d,t),x) <- readDateTime x-         (' ',x) <- LBS.uncons x-         (u,x) <- return $ first LBS.unpack $ LBS.break (== ' ') x-         args <- readArgs $ LBS.dropWhile isSpace x-         let (a,b) = partition (flip elem qstr . fst) args-         return entry{date = Just d, time = Just t, extra = b,-            search=fromList LBS.empty $ map snd a,-            unique = if u == "0" then Nothing else Just u}-    where-        readArgs x-            | LBS.null x = Just []-            | otherwise = do-                (a,x) <- readShortString x-                ('=',x) <- LBS.uncons x-                (b,x) <- readShortString x-                ys <- readArgs $ LBS.dropWhile isSpace x-                return $ (a,b):ys--readEntry _ = Nothing--------------------------------------------------------------------------- READ UTILITIES--readDate :: LBString -> Maybe ((Int,Int,Int), LBString)-readDate x = do-    (d1,x) <- LBS.readInt x-    ('-',x) <- LBS.uncons x-    (d2,x) <- LBS.readInt x-    ('-',x) <- LBS.uncons x-    (d3,x) <- LBS.readInt x-    return ((d1,d2,d2),x)--readDateTime :: LBString -> Maybe (((Int,Int,Int),(Int,Int,Int)), LBString)-readDateTime x = do-    (d,x) <- readDate x-    ('T',x) <- LBS.uncons x-    (t1,x) <- LBS.readInt x-    (':',x) <- LBS.uncons x-    (t2,x) <- LBS.readInt x-    (':',x) <- LBS.uncons x-    (t3,x) <- LBS.readInt x-    return ((d,(t1,t2,t3)),x)----- | String, as produced by show-readShowString :: LBString -> Maybe (LBString, LBString)-readShowString o@x = do-    ('\"',x) <- LBS.uncons x-    (a,x) <- return $ LBS.break (== '\"') x-    if '\\' `LBS.elem` a then do-        [(a,x)] <- return $ reads $ LBS.unpack o-        return (LBS.pack a, LBS.pack x)-     else do-        ('\"',x) <- LBS.uncons x-        return (a, x)----- | Either a string produced by show, or a isAlphaNum terminated chunk-readShortString :: LBString -> Maybe (LBString, LBString)-readShortString x | Just ('\"',_) <- LBS.uncons x = readShowString x-                  | otherwise = Just $ LBS.span isAlphaNum x----- | Either a space terminated chunk, or a quote terminated chunk-readQuoteString :: LBString -> Maybe (LBString, LBString)-readQuoteString x | Just ('\"',x) <- LBS.uncons x = do-    (a,x) <- return $ LBS.break (== '\"') x-    ('\"',x) <- LBS.uncons x-    return (a, LBS.dropWhile isSpace x)-readQuoteString x = do-    (a,x) <- return $ LBS.break (== ' ') x-    return (a, LBS.dropWhile isSpace x)-
− src/Console/Rank.hs 
@@ -1,35 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-module Console.Rank(rank) where--import General.Base-import Hoogle---rank :: FilePath -> IO ()-rank file = do-    src <- readFile' file-    res <- scoring $ scores $ parse $ lines src-    putStrLn res---scores :: ([String], [(String,[String])]) -> [(Score,Score)]-scores (pre,xs) = concatMap trans-    [-        [ fst $ head $ search db q ++ [error $ "Did not find in " ++ query ++ ", " ++ y]-        | y <- ys-        , let (err::String,db) = (error "this feature has been disabled" createDatabase) Haskell [] $ unlines $ pre ++ ["a::" ++ y]-        , null err || error "Errors while converting rank database"-        ]-    | (query,ys) <- xs, let q = right ("Could not parse query: " ++ query) $ parseQuery Haskell query]-    where right msg = either (\e -> error $ msg ++ "\n" ++ show e) id--trans (x:xs) = map ((,) x) xs ++ trans xs-trans [] = []---parse :: [String] -> ([String], [(String,[String])])-parse src = (db, [(drop 6 x, filter isReal $ takeWhile (not . isRank) xs) | x:xs <- tails rest, isRank x])-    where-        isReal x = not $ all isSpace x || "--" `isPrefixOf` x-        isRank = isPrefixOf "@rank "-        (db,rest) = break isRank src
− src/Console/Search.hs 
@@ -1,70 +0,0 @@-{-# LANGUAGE RecordWildCards #-}--module Console.Search(actionSearch) where--import CmdLine.All-import General.Base-import General.System-import System.Console.CmdArgs-import Hoogle---actionSearch :: CmdLine -> Query -> IO ()-actionSearch flags q = do-    (missing,dbs) <- loadQueryDatabases (databases flags) q-    unless (null missing) $ do-        n <- availableDatabases (databases flags)-        exitMessage $-            ("Could not find some databases: " ++ unwords missing) :-            "Searching in:" : map ("  "++) (databases flags) ++ [""] ++-            (if null n then ["There are no available databases, generate them with: hoogle data"]-             else ["Either the package does not exist or has not been generated"] ++-                  ["Generate more databases with: hoogle data all" | length n < 100] ++-                  ["Found " ++ show (length n) ++ " databases, including: " ++ unwords (take 5 n) | not $ null n])--    let sug = suggestions dbs q-    when (isJust sug) $-        putStrLn $ showTag $ fromJust sug-    verbose <- isLoud-    when verbose $ putStrLn "= ANSWERS ="--    when (color flags) $-        putStrLn $ "Searching for: " ++ showTag (renderQuery q)--    let res = restrict $ concatMap expand $ search dbs q-    if null res then-        putStrLn "No results found"-     else if info flags then do-        let Result{..} = snd $ head res-        putStrLns 2 $ disp verbose $ head res-        putStrLns 2 $ showTag docs-        case locations of-            (_,(_,p):_):_ -> putStrLn $ "From package " ++ p-            _ -> return ()-        putStrLns 1 $ showTag self-     else-        putStr $ unlines $ map (disp verbose) res-    where-        restrict | start2 == 0 && count2 == maxBound = id-                 | otherwise = take count2 . drop start2-            where start2 = maybe 0 (subtract 1) $ start flags-                  count2 = fromMaybe maxBound $ count flags--        showTag = if color flags then showTagANSI else showTagText--        expand (s,r) | null $ locations r = [(s,r)]-                     | otherwise = [(s,r{locations=[p]}) | p <- locations r]--        disp verbose (s,Result{..}) =-            (case locations of (_,_:(_,m):_):_ -> m ++ " "; _ -> "") ++-            showTag self ++-            (if verbose then "  -- " ++ show s else "") ++-            (if link flags then " -- " ++ head (map fst locations ++ [""]) 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/Console/Test.hs 
@@ -1,117 +0,0 @@-{-# LANGUAGE RecordWildCards,PatternGuards,ScopedTypeVariables #-}---- | Standalone tests are dependent only on themselves, example tests---   require a fully build Hoogle database.-module Console.Test(testPrepare, testFile) where--import Hoogle-import General.Base-import General.System-import System.FilePath-import Paths_hoogle-import CmdLine.All-import Test.All-import Control.Exception-import System.Console.CmdArgs---testPrepare :: IO ()-testPrepare = do-    putStrLn "Running static tests"-    test--    putStrLn "Converting testdata"-    performGC -- clean up the databases-    dat <- getDataDir-    createDirectoryIfMissing True $ dat </> "databases"-    src <- readFileUtf8 $ dat </> "testdata.txt"-    let dbfile = dat </> "databases/testdata.hoo"-    errs <- createDatabase "http://hackage.haskell.org/" Haskell [] src dbfile-    unless (null errs) $ error $ unlines $ "Couldn't convert testdata database:" : map show errs-    db <- loadDatabase dbfile-    -- this test is now mostly redundant because i can't get the file before saving-    when (show db /= show db) $ error "Database did not save properly"---testFile :: (CmdLine -> IO ()) -> FilePath -> IO Int-testFile run srcfile = do-    putStrLn $ "Testing " ++ srcfile-    src <- readFile' srcfile-    xs <- mapM (runTest run) $ parseTests src-    return $ length $ filter not xs---data Testcase = Testcase-    {testLine :: Int-    ,testQuery :: String-    ,testResults :: [String]-    }---parseTests :: String -> [Testcase]-parseTests = f . zip [1..] . lines-    where-        f ((i,x):xs)-            | "--" `isPrefixOf` x = f xs-            | all isSpace x = f xs-            | otherwise = Testcase i x (map snd a) : f b-            where (a,b) = break (all isSpace . snd) xs-        f [] = []---parseArgs :: String -> [String]-parseArgs "" = []-parseArgs ('\"':xs) = a : parseArgs (drop 1 b)-    where (a,b) = break (== '\"') xs-parseArgs xs = a : parseArgs (dropWhile isSpace b)-    where (a,b) = break isSpace xs---runTest :: (CmdLine -> IO ()) -> Testcase -> IO Bool-runTest run Testcase{..} = do-    whenLoud $ putStrLn $ "Testing: " ++ testQuery-    args <- withArgs (parseArgs testQuery) cmdLine-    res <- try $ captureOutput $ run args-    case res of-        Left (x :: SomeException) -> putStrLn ("Error, test crashed: " ++ testQuery ++ ", with " ++ show x) >> return False-        Right Nothing -> putStrLn "Can't run tests on GHC < 6.12" >> return False-        Right (Just x) -> case matchOutput testResults (lines x) of-            Nothing -> return True-            Just x -> do-                putStrLn $ "Failed test on line " ++ show testLine ++ "\n" ++ x-                return False----- support @reoder, @not, @exact, @now-matchOutput :: [String] -> [String] -> Maybe String -- Nothing is success-matchOutput want got = f want ([],got)-    where-        f [] _ = Nothing-        f (x:xs) a = case match (code x) a of-            Nothing -> Just $ unlines $ ["Failed to match","Expected: " ++ x,"Got:"] ++ fst a ++ snd a-            Just a -> f xs a--        code ('@':xs) = second (drop 1) $ break (== ' ') xs-        code xs = ("",xs)--        -- given (code,match) (past,future) return Nothing for failure or a new (past,future)-        match :: (String,String) -> ([String],[String]) -> Maybe ([String],[String])-        match ("not",x) (past,future)-            | Just (a,b) <- find x future = Nothing-            | otherwise = Just ([],future)-        match ("reorder",x) (past,future)-            | Just (a,b) <- find x past = Just (a++b, future)-            | Just (a,b) <- find x future = Just (past++a, b)-            | otherwise = Nothing-        match ("now",x) (past,future)-            | Just ([],b) <- find x future = Just ([],b)-            | otherwise = Nothing-        match ("",x) (past,future)-            | Just (a,b) <- find x future = Just (a,b)-            | otherwise = Nothing-        match (code,x) _ = error $ "Unknown test code: " ++ code--        -- given a needle, return Maybe the bits before and after-        find :: String -> [String] -> Maybe ([String],[String])-        find x ys = if null b then Nothing else Just (a,tail b)-            where (a,b) = break (\y -> words x `isInfixOf` words y) ys
− src/General/Base.hs 
@@ -1,164 +0,0 @@-{-# LANGUAGE CPP #-}---- | Module for "pure" things in the base, and things I think should---   have been in base, or could plausibly be added.-module General.Base(module General.Base, module X) where--import Prelude as X-#if __GLASGOW_HASKELL__ < 710-import Control.Applicative as X ((<*>),(<$>))-#endif-import Control.Arrow as X-import Control.DeepSeq as X-import Control.Monad as X-import Data.Char as X-import Data.Data as X (Data,Typeable)-import Data.Either as X (partitionEithers)-import Data.Function as X-import Data.List as X-import Data.Maybe as X-import Data.Monoid as X-import Data.Ord as X-import Data.String as X-import Data.Int as X-import Data.Word as X-import Debug.Trace as X (trace)-import Numeric as X (readHex,showHex)-import qualified Data.ByteString.Char8 as BS-import qualified Data.ByteString.Lazy.Char8 as LBS--import System.IO--#if __GLASGOW_HASKELL__ < 710-sortOn f = sortBy (comparing f)-#endif----type LBString = LBS.ByteString-type BString = BS.ByteString-lbsUnpack = LBS.unpack-bsUnpack = BS.unpack---bsReplace :: BString -> BString -> BString -> BString-bsReplace find rep = BS.concat . f-    where-        nfind = BS.length find--        f x | BS.null b = [a]-            | otherwise = a : rep : f (BS.drop nfind b) -            where (a,b) = BS.breakSubstring find x--lbsReplace :: LBString -> LBString -> LBString -> LBString-lbsReplace find rep x = LBS.fromChunks [bsReplace (f find) (f rep) (f x)]-    where f = BS.concat . LBS.toChunks----- | A URL, or internet address. These addresses will usually start with either---   @http:\/\/@ or @file:\/\/@.-type URL = String--fst3 (a,b,c) = a-snd3 (a,b,c) = b-thd3 (a,b,c) = c---swap (a,b) = (b,a)--fromLeft (Left x) = x-fromRight (Right x) = x--isLeft Left{} = True; isLeft _ = False-isRight Right{} = True; isRight _ = False---concatMapM f = liftM concat . mapM f---unzipEithers :: [Either a b] -> ([a],[b])-unzipEithers [] = ([],[])-unzipEithers (Left x:xs) = (x:a,b)-    where (a,b) = unzipEithers xs-unzipEithers (Right x:xs) = (a,x:b)-    where (a,b) = unzipEithers xs---initLast :: [a] -> ([a], a)-initLast [] = error "initLast, empty list []"-initLast [x] = ([], x)-initLast (x:xs) = (x:a, b)-    where (a,b) = initLast xs---lower = map toLower-upper = map toUpper---readFile' x = do-    src <- readFile x-    length src `seq` return src---readFileUtf8' :: FilePath -> IO String-readFileUtf8' x = do-    src <- readFileUtf8 x-    length src `seq` return src---readFileUtf8 :: FilePath -> IO String-#if __GLASGOW_HASKELL__ < 612-readFileUtf8 x = readFile x-#else-readFileUtf8 x = do-    h <- openFile x ReadMode-    hSetEncoding h utf8-    hGetContents h-#endif---readFileLatin1' :: FilePath -> IO String-readFileLatin1' x = do-    src <- readFileLatin1 x-    length src `seq` return src---readFileLatin1 :: FilePath -> IO String-#if __GLASGOW_HASKELL__ < 612-readFileLatin1 x = readFile x-#else-readFileLatin1 x = do-    h <- openFile x ReadMode-    hSetEncoding h latin1-    hGetContents h-#endif---writeFileUtf8 :: FilePath -> String -> IO ()-#if __GLASGOW_HASKELL__ < 612-writeFileUtf8 x y = writeFile x y-#else-writeFileUtf8 x y = withFile x WriteMode $ \h -> do-    hSetEncoding h utf8-    hPutStr h y-#endif---writeFileBinary :: FilePath -> String -> IO ()-writeFileBinary x y = withBinaryFile x WriteMode $ \h -> hPutStr h y---ltrim = dropWhile isSpace-rtrim = reverse . ltrim . reverse-trim = ltrim . rtrim---chop :: ([a] -> (b, [a])) -> [a] -> [b]-chop _ [] = []-chop f as = b : chop f as'-    where (b, as') = f as---fromList :: a -> [a] -> a-fromList x [] = x-fromList x (y:ys) = y
− src/General/BurrowsWheeler.hs 
@@ -1,62 +0,0 @@-{-# LANGUAGE FlexibleContexts, PatternGuards #-}---- | Burrows-Wheeler Transform, based on <http://www.cs.jhu.edu/~langmea/resources/bwt_fm.pdf>.-module General.BurrowsWheeler(compress, compressIndicies, decompress) where--import qualified Data.ByteString as BS-import qualified Data.Vector.Algorithms.AmericanFlag as AmericanFlag-import qualified Data.Vector.Unboxed as V-import qualified Data.Vector.Unboxed.Mutable as VM-import Control.Monad.ST-import Data.Word-import Data.Function---compress :: BS.ByteString -> (Int, BS.ByteString)-compress bs = (i, fst $ BS.unfoldrN (BS.length bs) step 0)-    where (i, vs) = compressIndicies bs-          step i = Just (BS.index bs (fromIntegral $ vs V.! i-1), i + 1)---compressIndicies :: BS.ByteString -> (Int, V.Vector Word32)-compressIndicies bs | Just i <- V.elemIndex 0 is = (i, V.take i is V.++ V.drop (i+1) is)-    where-        len = BS.length bs-        is = V.modify (AmericanFlag.sortBy (compare `on` slice) terminate size index) $-                    V.enumFromN (0 :: Word32) $ len + 1--        slice i = BS.drop (fromIntegral i) bs--        -- Copied from the Lexicographic ByteString instance, adapted to use an offset-        size = 257-        terminate b i = i + fromIntegral b >= len-        index i b-            | i + fromIntegral b >= len = 0-            | otherwise = fromIntegral (BS.index bs $ i + fromIntegral b) + 1---decompress :: (Int, BS.ByteString) -> BS.ByteString-decompress (pos, bs) = BS.reverse $ fst $ BS.unfoldrN (BS.length bs) step 0-    where-        step i | j == -1 = Nothing-               | otherwise = let c = BS.index bs j in Just (c, fromIntegral $ (first V.! fromIntegral c) + (ranks V.! j) + 1)-            where j = if i >= pos then i-1 else i-        (ranks, tots) = rankBwt bs-        first = firstCol tots---rankBwt :: BS.ByteString -> (V.Vector Word32, V.Vector Word32)-rankBwt bs = runST $ do-    tots <- VM.replicate 256 0-    ranks <- V.generateM (BS.length bs) $ \i -> do-        let c = fromIntegral $ BS.index bs i-        j <- VM.read tots c-        VM.write tots c $ j + 1-        return j-    tots <- V.freeze tots-    return (ranks, tots)----- If you sorted the input, at what index would 'c' come-firstCol :: V.Vector Word32 -> V.Vector Word32-firstCol = V.prescanl' (+) 0
+ src/General/Conduit.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE NoMonomorphismRestriction, PatternGuards, CPP #-}++module General.Conduit(+    module Data.Conduit, MonadIO, liftIO,+    sourceList, sinkList, sourceLStr,+    mapC, mapAccumC, filterC,+    mapMC, mapAccumMC,+    (|$|), pipelineC, groupOnLastC,+    zipFromC, linesCR+    ) where++import Data.Void+import Data.Conduit+import Data.Conduit.List as C+import Data.Conduit.Binary as C+import Data.Maybe+import Control.Applicative+import Control.Monad.Extra+import Control.Exception+import qualified Data.ByteString.Char8 as BS+import Control.Concurrent.Extra hiding (yield)+import Control.Monad.IO.Class+import General.Str+import Prelude+++mapC = C.map+mapMC = C.mapM+mapAccumC f = C.mapAccum (\x a -> a `seq` f a x)+mapAccumMC f = C.mapAccumM (\x a -> a `seq` f a x)+filterC = C.filter++zipFromC :: (Monad m, Enum i) => i -> ConduitM a (i, a) m ()+zipFromC = void . mapAccumC (\i x -> (succ i, (i,x)))++(|$|) :: Monad m => ConduitM i o m r1 -> ConduitM i o m r2 -> ConduitM i o m (r1,r2)+(|$|) a b = getZipConduit $ (,) <$> ZipConduit a <*> ZipConduit b++sinkList :: Monad m => ConduitM a o m [a]+sinkList = consume++-- | Group things while they have the same function result, only return the last value.+--   Conduit version of @groupOnLast f = map last . groupOn f@.+groupOnLastC :: (Monad m, Eq b) => (a -> b) -> ConduitM a a m ()+groupOnLastC op = do+    x <- await+    whenJust x $ \x -> f (op x) x+    where+        f k v = await >>= \x -> case x of+            Nothing -> yield v+            Just v2 | let k2 = op v2 -> do+                when (k /= k2) $ yield v+                f k2 v2+++linesCR :: Monad m => ConduitM BStr BStr m ()+linesCR = C.lines .| mapC f+    where f x | Just (x, '\r') <- BS.unsnoc x = x+              | otherwise = x++sourceLStr :: Monad m => LBStr -> ConduitM i BStr m ()+sourceLStr = sourceList . lbstrToChunks+++pipelineC :: Int -> ConduitM o Void IO r -> ConduitM o Void IO r+pipelineC buffer sink = do+    sem <- liftIO $ newQSem buffer  -- how many are in flow, to avoid memory leaks+    chan <- liftIO newChan          -- the items in flow (type o)+    bar <- liftIO newBarrier        -- the result type (type r)+    me <- liftIO myThreadId+    liftIO $ flip forkFinally (either (throwTo me) (signalBarrier bar)) $ do+        runConduit $+            (whileM $ do+                x <- liftIO $ readChan chan+                liftIO $ signalQSem sem+                whenJust x yield+                pure $ isJust x) .|+            sink+    awaitForever $ \x -> liftIO $ do+        waitQSem sem+        writeChan chan $ Just x+    liftIO $ writeChan chan Nothing+    liftIO $ waitBarrier bar
− src/General/FMIndex.hs 
@@ -1,61 +0,0 @@--module General.FMIndex(-    FMIndex,-    create, fromHandle,-    extract,-    Find(..), count, locate-    ) where--import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as LBS-import Data.Binary-import Control.Applicative-import Control.Arrow-import System.IO-import Prelude---data FMIndex a = FMIndex Char [(BS.ByteString, a)] deriving Show--{--data FMIndex a = FMIndex-    {specialChar :: Char -- Character used to separate words, and which there are associations for-    ,positions :: V.Vector Word32 -- if positions[c] = n, that means there are n substrings that are less than c-    ,associated :: V.Vector a -- values associated with each specialChar-    ,rankAll :: V.Vector Word32 -- ranks, stored every 1024 entries, where rankAll[(n*256)/1024 + c] = rank of c at character n-    ,contents :: BS.ByteString-    }--}--instance Functor FMIndex where-    fmap f (FMIndex a b) = FMIndex a $ map (second f) b--instance Binary a => Binary (FMIndex a) where-    put (FMIndex a b) = put a >> put b-    get = FMIndex <$> get <*> get---- assign these indicies to this information-create :: Char -> [(BS.ByteString, a)] -> FMIndex a-create = FMIndex--extract :: FMIndex a -> [(BS.ByteString, a)]-extract (FMIndex _ x) = x--data Find = Exact | Prefix | Suffix | Infix--count :: FMIndex a -> Find -> BS.ByteString -> Int-count idx mode x = length $ locate idx mode x---locate :: FMIndex a -> Find -> BS.ByteString -> [(a, Int)] -- The int is how many characters you are along this string-locate (FMIndex _ xs) mode x = [(i, p) | (a,i) <- xs, Just p <- [op a]]-    where-        op = case mode of-            Exact -> \a -> if x == a then Just 0 else Nothing-            Prefix -> \a -> if x `BS.isPrefixOf` a then Just 0 else Nothing-            Suffix -> \a -> if x `BS.isSuffixOf` a then Just $ BS.length a - BS.length x else Nothing-            Infix -> \a -> let (y,z) = BS.breakSubstring x a in if BS.null z then Nothing else Just $ BS.length y---fromHandle :: Binary a => Handle -> IO (FMIndex a)-fromHandle = fmap decode . LBS.hGetContents
− src/General/Heap.hs 
@@ -1,75 +0,0 @@--module General.Heap(-    Heap, empty,-    fromList, toList, elems,-    singleton,-    insert, insertList,-    pop, popUntil, popWhile-    ) where--import Prelude-import qualified Data.Map as Map----- (k,v) pairs are stored in reverse order--newtype Heap k v = Heap (Map.Map k [(k,v)])--empty :: Heap k v-empty = Heap Map.empty---fromList :: Ord k => [(k,v)] -> Heap k v-fromList xs = insertList xs empty---toList :: Heap k v -> [(k,v)]-toList (Heap mp) = concatMap reverse $ Map.elems mp---elems :: Heap k v -> [v]-elems (Heap mp) = concatMap (reverse . map snd) $ Map.elems mp---singleton :: Ord k => k -> v -> Heap k v-singleton k v = insert k v empty----- insert a value with a cost, does NOT overwrite values-insert :: Ord k => k -> v -> Heap k v -> Heap k v-insert k v (Heap xs) = Heap $ Map.insertWith (++) k [(k,v)] xs---insertList :: Ord k => [(k,v)] -> Heap k v -> Heap k v-insertList xs mp = foldr (uncurry insert) mp xs----- retrieve the lowest value (can use minView in the future)--- does NOT guarantee to be the first one inserted at that level-pop :: Ord k => Heap k v -> Maybe ((k,v), Heap k v)-pop (Heap mp) | Map.null mp = Nothing-              | null kvs    = Just ((k1,v1), Heap mp2)-              | otherwise   = Just ((k1,v1), Heap $ Map.insert k kvs mp2)-    where-        ((k,(k1,v1):kvs),mp2) = Map.deleteFindMin mp----- until you reach this key, do not pop those at this key--- guarantees to return by order, then insertion time-popUntil :: Ord k => k -> Heap k v -> ([v], Heap k v)-popUntil x = popBy (< x)----- until you reach this key, and then pop those at this key--- guarantees to return by order, then insertion time-popWhile :: Ord k => k -> Heap k v -> ([v], Heap k v)-popWhile x = popBy (<= x)---popBy :: Ord k => (k -> Bool) -> Heap k v -> ([v], Heap k v)-popBy cmp (Heap mp)-    | Map.null mp || not (cmp k) = ([], Heap mp)-    | otherwise = (reverse (map snd kvs) ++ res, mp3)-        where-            ((k,kvs),mp2) = Map.deleteFindMin mp-            (res,mp3) = popBy cmp (Heap mp2)
+ src/General/IString.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE PatternGuards, DeriveDataTypeable, ViewPatterns, BangPatterns #-}++-- | Interned strings+module General.IString(+    IString, fromIString, toIString+    ) where++import Data.Data+import Data.IORef+import Control.DeepSeq+import General.Str+import qualified Data.Map as Map+import System.IO.Unsafe+++data IString = IString {-# UNPACK #-} !Int !Str+    deriving (Data,Typeable)++instance Eq IString where+    IString x _ == IString y _ = x == y++instance Ord IString where+    compare (IString x1 x2) (IString y1 y2)+        | x1 == y1 = EQ+        | otherwise = compare x2 y2++instance Show IString where show = strUnpack . fromIString+instance NFData IString where rnf IString{} = () -- we force the string at construction time+++{-# NOINLINE istrings #-}+istrings :: IORef (Map.Map Str IString)+istrings = unsafePerformIO $ newIORef Map.empty++fromIString :: IString -> Str+fromIString (IString _ x) = x++toIString :: Str -> IString+toIString x = unsafePerformIO $ atomicModifyIORef' istrings $ \mp -> case Map.lookup x mp of+    Just v -> (mp, v)+    Nothing -> let res = IString (Map.size mp) x in (Map.insert x res mp, res)
+ src/General/Log.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE RecordWildCards, ViewPatterns, TupleSections, PatternGuards #-}++module General.Log(+    Log, logCreate, logNone, logAddMessage, logAddEntry,+    Summary(..), logSummary,+    ) where++import Control.Concurrent.Extra+import Control.Applicative+import System.Directory+import System.IO+import Data.Hashable+import Data.Time.Calendar+import Data.Time.Clock+import Numeric.Extra+import Control.Monad.Extra+import qualified Data.IntSet as Set+import qualified Data.Map.Strict as Map+import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.ByteString.Char8 as BS+import Data.Semigroup+import General.Util+import Data.Maybe+import Data.List+import Data.IORef.Extra+import Safe+import Prelude+++data Log = Log+    {logOutput :: Maybe (Var Handle)+    ,logCurrent :: IORef (Map.Map Day SummaryI)+    ,logInteresting :: String -> Bool+    }++showTime :: UTCTime -> String+showTime = showUTCTime "%Y-%m-%dT%H:%M:%S%Q"++logNone :: IO Log+logNone = do ref <- newIORef Map.empty; pure $ Log Nothing ref (const False)++logCreate :: Either Handle FilePath -> (BS.ByteString -> Bool) -> IO Log+logCreate store interesting = do+    (h, old) <- case store of+        Left h -> pure (h, Map.empty)+        Right file -> do+            b <- doesFileExist file+            mp <- if not b then pure Map.empty else withFile file ReadMode $ \h -> do+                src <- LBS.hGetContents h+                let xs = mapMaybe (parseLogLine interesting . LBS.toStrict) $ LBS.lines src+                pure $! foldl' (\mp (k,v) -> Map.alter (Just . maybe v (<> v)) k mp) Map.empty xs+            (,mp) <$> openFile file AppendMode+    hSetBuffering h LineBuffering+    var <- newVar h+    ref <- newIORef old+    pure $ Log (Just var) ref (interesting . BS.pack)++logAddMessage :: Log -> String -> IO ()+logAddMessage Log{..} msg = do+    time <- showTime <$> getCurrentTime+    whenJust logOutput $ \var -> withVar var $ \h ->+        hPutStrLn h $ time ++ " - " ++ msg++logAddEntry :: Log -> String -> String -> Double -> Maybe String -> IO ()+logAddEntry Log{..} user question taken err = do+    time <- getCurrentTime+    let add v = atomicModifyIORef_ logCurrent $ \mp -> Map.alter (Just . maybe v (<> v)) (utctDay time) mp+    if logInteresting question then+        add $ SummaryI (Set.singleton $ hash $ LBS.pack user) 1 taken (toAverage taken) (if isJust err then 1 else 0)+     else if isJust err then+        add mempty{iErrors=1}+     else+        pure ()+    whenJust logOutput $ \var -> withVar var $ \h ->+        hPutStrLn h $ unwords $ [showTime time, user, showDP 3 taken, question] +++                                maybeToList (fmap ((++) "ERROR: " . unwords . words) err)++-- Summary collapsed+data Summary = Summary+    {summaryDate :: Day+    ,summaryUsers :: {-# UNPACK #-} !Int+    ,summaryUses :: {-# UNPACK #-} !Int+    ,summarySlowest :: {-# UNPACK #-} !Double+    ,summaryAverage :: {-# UNPACK #-} !(Average Double)+    ,summaryErrors :: {-# UNPACK #-} !Int+    }++-- Summary accumulating+data SummaryI = SummaryI+    {iUsers :: !Set.IntSet -- number of distinct users+    ,iUses :: !Int -- number of uses+    ,iSlowest :: !Double -- slowest result+    ,iAverage :: !(Average Double) -- average result+    ,iErrors :: !Int -- number of errors+    }++instance Semigroup SummaryI where+    SummaryI x1 x2 x3 x4 x5 <> SummaryI y1 y2 y3 y4 y5 =+        SummaryI (f x1 y1) (x2+y2) (max x3 y3) (x4 <> y4) (x5+y5)+        -- more efficient union for the very common case of a single element+        where f x y | Set.size x == 1 = Set.insert (headErr $ Set.toList x) y+                    | Set.size y == 1 = Set.insert (headErr $ Set.toList y) x+                    | otherwise = Set.union x y++instance Monoid SummaryI where+    mempty = SummaryI Set.empty 0 0 (toAverage 0) 0+    mappend = (<>)++summarize :: Day -> SummaryI -> Summary+summarize date SummaryI{..} = Summary date (Set.size iUsers) iUses iSlowest iAverage iErrors++-- This noinline solves a massive memory leak at -O2, and I have no idea why+{-# NOINLINE parseLogLine #-}+parseLogLine :: (BS.ByteString -> Bool) -> BS.ByteString -> Maybe (Day, SummaryI)+parseLogLine interesting (BS.words -> time:user:dur:query:err)+    | use || isErr+    , user /= BS.singleton '-'+    , Just [a, b, c] <- fmap (map fst) $ mapM BS.readInt $ BS.split '-' $ BS.takeWhile (/= 'T') time+    = Just (fromGregorian (fromIntegral a) b c, SummaryI+        (if use then Set.singleton $ hash user else Set.empty)+        (if use then 1 else 0)+        (if use then dur2 else 0)+        (toAverage $ if use then dur2 else 0)+        (if isErr then 1 else 0))+    where use = interesting query+          isErr = [BS.pack "ERROR:"] `isPrefixOf` err+          dur2 = parseDuration dur+parseLogLine _ _ = Nothing++-- Hoogle used to store whole numbers of milliseconds, then it switched to 4dp doubles with a guaranteed '.'+parseDuration :: BS.ByteString -> Double+parseDuration x+    | Just (whole, x) <- BS.readInt x+    = case BS.uncons x of+        Just ('.', x)+            | Just (frac, y) <- BS.readInt x+                -> intToDouble whole + (intToDouble frac / (10 ^ (BS.length x - BS.length y)))+            | otherwise -> 0+        _ -> intToDouble whole / 1000+parseDuration _ = 0+++logSummary :: Log -> IO [Summary]+logSummary Log{..} = map (uncurry summarize) . Map.toAscList <$> readIORef logCurrent
+ src/General/Store.hs view
@@ -0,0 +1,252 @@+{-# LANGUAGE DeriveDataTypeable, GADTs, PatternGuards, RecordWildCards,+             ScopedTypeVariables, ViewPatterns #-}++module General.Store(+    Typeable, Stored,+    intSize, intFromBS, intToBS, encodeBS, decodeBS,+    StoreWrite, storeWriteFile, storeWrite, storeWritePart,+    StoreRead, storeReadFile, storeRead,+    Jagged, jaggedFromList, jaggedAsk,+    ) where++import Control.Applicative+import Control.DeepSeq+import Control.Exception+import Control.Exception.Extra+import Control.Monad.Extra+import Data.Binary+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Unsafe as BS+import Data.Char+import Data.IORef.Extra+import Data.List.Extra+import qualified Data.Map as Map+import Data.Typeable+import qualified Data.Vector.Storable as V+import Data.Version+import Foreign.C.String+import Foreign.ForeignPtr+import Foreign.Ptr+import Foreign.Storable+import General.Util+import Numeric.Extra+import Paths_hoogle+import Prelude+import System.Directory (renameFile)+import System.FilePath (takeDirectory, takeFileName)+import System.IO.Extra (Handle, hTell, hClose, hPutBuf)+import System.IO.MMap+import System.IO.Temp (withTempFile)+import System.IO.Unsafe++-- Ensure the string is always 25 chars long, so version numbers don't change its size+-- Only use the first two components of the version number to identify the database+verString = BS.pack $ take 25 $ "HOOGLE-" ++ showVersion (trimVersion 3 version) ++ repeat ' '++---------------------------------------------------------------------+-- SERIALISATION HELPERS++intSize :: Int+intSize = 4++intToBS :: Int -> BS.ByteString+intToBS i = encodeBS (fromIntegral i :: Word32)++intFromBS :: BS.ByteString -> Int+intFromBS bs = fromIntegral (decodeBS bs :: Word32)++encodeBS :: Binary a => a -> BS.ByteString+encodeBS = LBS.toStrict . encode++decodeBS :: Binary a => BS.ByteString -> a+decodeBS = decode . LBS.fromStrict+++---------------------------------------------------------------------+-- TREE INDEX STRUCTURE++-- each atom name is either unique (a scope) or "" (a list entry)+data Atom = Atom+    {atomType :: String -- Type that the atom contains (for sanity checking)+    ,atomPosition :: {-# UNPACK #-} !Int -- Position at which the atom starts in the file+    ,atomSize :: {-# UNPACK #-} !Int -- Number of bytes the value takes up+    } deriving Show++instance Binary Atom where+    put (Atom a b c) = put a >> put b >> put c+    get = liftA3 Atom get get get++---------------------------------------------------------------------+-- TYPE CLASS++class Typeable a => Stored a where+    storedWrite :: Typeable (t a) => StoreWrite -> t a -> Bool -> a -> IO ()+    storedRead :: Typeable (t a) => StoreRead -> t a -> a++instance Stored BS.ByteString where+    storedWrite store k part v = BS.unsafeUseAsCStringLen v $ \x -> storeWriteAtom store k part x+    storedRead store k = storeReadAtom store k BS.unsafePackCStringLen++instance forall a . (Typeable a, Storable a) => Stored (V.Vector a) where+    storedWrite store k part v = V.unsafeWith v $ \ptr ->+        storeWriteAtom store k part (castPtr ptr, V.length v * sizeOf (undefined :: a))+    storedRead store k = storeReadAtom store k $ \(ptr, len) -> do+        ptr <- newForeignPtr_ $ castPtr ptr+        pure $ V.unsafeFromForeignPtr0 ptr (len `div` sizeOf (undefined :: a))+++---------------------------------------------------------------------+-- WRITE OUT++data SW = SW+    {swHandle :: Handle -- Immutable handle I write to+    ,swPosition :: !Int -- Position within swHandle+    ,swAtoms :: [(String, Atom)] -- List of pieces, in reverse+    }++newtype StoreWrite = StoreWrite (IORef SW)++storeWriteFile :: FilePath -> (StoreWrite -> IO a) -> IO ([String], a)+storeWriteFile file act = do+    atoms <- newIORef Map.empty+    parts <- newIORef Nothing+    withTempFile (takeDirectory file) (takeFileName file) $ \tmpFile h -> do+        -- put the version string at the start and end, so we can tell truncation vs wrong version+        BS.hPut h verString+        ref <- newIORef $ SW h (BS.length verString) []+        res <- act $ StoreWrite ref+        SW{..} <- readIORef ref++        -- sort the atoms and validate there are no duplicates+        let atoms = Map.fromList swAtoms+        when (Map.size atoms /= length swAtoms) $+            errorIO $ "Some duplicate names have been written out: " ++ show (length swAtoms - Map.size atoms) ++ " duplicates"++        -- write the atoms out, then put the size at the end+        let bs = encodeBS atoms+        BS.hPut h bs+        BS.hPut h $ intToBS $ BS.length bs+        BS.hPut h verString++        final <- hTell h+        let stats = prettyTable 0 "Bytes" $+                ("Overheads", intToDouble $ fromIntegral final - sum (map atomSize $ Map.elems atoms)) :+                [(name ++ " :: " ++ atomType, intToDouble atomSize) | (name, Atom{..}) <- Map.toList atoms]+        hClose h+        renameFile tmpFile file+        pure (stats, res)++storeWrite :: (Typeable (t a), Typeable a, Stored a) => StoreWrite -> t a -> a -> IO ()+storeWrite store k = storedWrite store k False++storeWritePart :: forall t a . (Typeable (t a), Typeable a, Stored a) => StoreWrite -> t a -> a -> IO ()+storeWritePart store k = storedWrite store k True++{-# NOINLINE putBuffer #-}+putBuffer a b c = hPutBuf a b c++storeWriteAtom :: forall t a . (Typeable (t a), Typeable a) => StoreWrite -> t a -> Bool -> CStringLen -> IO ()+storeWriteAtom (StoreWrite ref) (show . typeOf -> key) part (ptr, len) = do+    sw@SW{..} <- readIORef ref+    putBuffer swHandle ptr len++    let val = show $ typeRep (Proxy :: Proxy a)+    atoms <- case swAtoms of+        (keyOld,a):xs | part, key == keyOld -> do+            let size = atomSize a + len+            evaluate size+            pure $ (key,a{atomSize=size}) : xs+        _ -> pure $ (key, Atom val swPosition len) : swAtoms+    writeIORef' ref sw{swPosition = swPosition + len, swAtoms = atoms}+++---------------------------------------------------------------------+-- READ OUT++data StoreRead = StoreRead+    {srFile :: FilePath+    ,srLen :: Int+    ,srPtr :: Ptr ()+    ,srAtoms :: Map.Map String Atom+    }++storeReadFile :: NFData a => FilePath -> (StoreRead -> IO a) -> IO a+storeReadFile file act = mmapWithFilePtr file ReadOnly Nothing $ \(ptr, len) -> strict $ do+    -- check is longer than my version string+    when (len < (BS.length verString * 2) + intSize) $+        errorIO $ "The Hoogle file " ++ file ++ " is corrupt, only " ++ show len ++ " bytes."++    let verN = BS.length verString+    verEnd <- BS.unsafePackCStringLen (plusPtr ptr $ len - verN, verN)+    when (verString /= verEnd) $ do+        verStart <- BS.unsafePackCStringLen (plusPtr ptr 0, verN)+        if verString /= verStart then+            errorIO $ "The Hoogle file " ++ file ++ " is the wrong version or format.\n" +++                      "Expected: " ++ trim (BS.unpack verString) ++ "\n" +++                      "Got     : " ++ map (\x -> if isAlphaNum x || x `elem` "_-. " then x else '?') (trim $ BS.unpack verStart)+         else+            errorIO $ "The Hoogle file " ++ file ++ " is truncated, probably due to an error during creation."++    atomSize <- intFromBS <$> BS.unsafePackCStringLen (plusPtr ptr $ len - verN - intSize, intSize)+    when (len < verN + intSize + atomSize) $+        errorIO $ "The Hoogle file " ++ file ++ " is corrupt, couldn't read atom table."+    atoms <- decodeBS <$> BS.unsafePackCStringLen (plusPtr ptr $ len - verN - intSize - atomSize, atomSize)+    act $ StoreRead file len ptr atoms++storeRead :: (Typeable (t a), Typeable a, Stored a) => StoreRead -> t a -> a+storeRead = storedRead+++storeReadAtom :: forall a t . (Typeable (t a), Typeable a) => StoreRead -> t a -> (CStringLen -> IO a) -> a+storeReadAtom StoreRead{..} (typeOf -> k) unpack = unsafePerformIO $ do+    let key = show k+    let val = show $ typeRep (Proxy :: Proxy a)+    let corrupt msg = errorIO $ "The Hoogle file " ++ srFile ++ " is corrupt, " ++ key ++ " " ++ msg ++ "."+    case Map.lookup key srAtoms of+        Nothing -> corrupt "is missing"+        Just Atom{..}+            | atomType /= val -> corrupt $ "has type " ++ atomType ++ ", expected " ++ val+            | atomPosition < 0 || atomPosition + atomSize > srLen -> corrupt "has incorrect bounds"+            | otherwise -> unpack (plusPtr srPtr atomPosition, atomSize)++---------------------------------------------------------------------+-- PAIRS++newtype Fst k v where Fst :: k -> Fst k a deriving Typeable+newtype Snd k v where Snd :: k -> Snd k b deriving Typeable++instance (Typeable a, Typeable b, Stored a, Stored b) => Stored (a,b) where+    storedWrite store k False (a,b) = storeWrite store (Fst k) a >> storeWrite store (Snd k) b+    storedRead store k = (storeRead store $ Fst k, storeRead store $ Snd k)+++---------------------------------------------------------------------+-- LITERALS++data StoredInt k v where StoredInt :: k -> StoredInt k BS.ByteString deriving Typeable++instance Stored Int where+    storedWrite store k False v = storeWrite store (StoredInt k) $ intToBS v+    storedRead store k = intFromBS $ storeRead store (StoredInt k)+++---------------------------------------------------------------------+-- JAGGED ARRAYS++data Jagged a = Jagged (V.Vector Word32) (V.Vector a) deriving Typeable+data JaggedStore k v where JaggedStore :: k -> JaggedStore k (V.Vector Word32, V.Vector a) deriving Typeable++jaggedFromList :: Storable a => [[a]] -> Jagged a+jaggedFromList xs = Jagged is vs+    where is = V.fromList $ scanl (+) 0 $ map (\x -> fromIntegral $ length x :: Word32) xs+          vs = V.fromList $ concat xs++jaggedAsk :: Storable a => Jagged a -> Int -> V.Vector a+jaggedAsk (Jagged is vs) i = V.slice start (end - start) vs+    where start = fromIntegral $ is V.! i+          end   = fromIntegral $ is V.! succ i++instance (Typeable a, Storable a) => Stored (Jagged a) where+    storedWrite store k False (Jagged is vs) = storeWrite store (JaggedStore k) (is, vs)+    storedRead store k = uncurry Jagged $ storeRead store $ JaggedStore k
+ src/General/Str.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE PatternGuards, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}++-- | ByteString wrappers which don't require special imports and are all UTF8 safe+module General.Str(+    Str, strPack, strUnpack, strNull, strCopy, strCons,+    BStr, bstrPack, bstrUnpack, bstrReadFile, bstrSplitInfix, bstrNull, bstrStripPrefix, bstrTrimStart,+    LBStr, lbstrPack, lbstrUnpack, lbstrToChunks, lbstrFromChunks,+    BStr0, bstr0Join, bstr0Split+    ) where++import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.UTF8 as US+import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.ByteString.Lazy.UTF8 as LUS+import qualified Data.Text as T+import Control.DeepSeq+import Data.Char+import Data.Data+import Data.List+import Data.Semigroup+import Data.String+import Prelude+++newtype Str = Str { fromStr :: T.Text }+    deriving (Data, Typeable, Eq, Ord, Semigroup, Monoid)++instance Show Str where show = strUnpack+instance NFData Str where rnf x = x `seq` ()+++type BStr = BS.ByteString++type LBStr = LBS.ByteString+++strPack :: String -> Str+strPack = Str . T.pack++strUnpack :: Str -> String+strUnpack = T.unpack . fromStr++strCons :: Char -> Str -> Str+strCons c = Str . T.cons c . fromStr++strCopy :: Str -> Str+strCopy = Str . T.copy . fromStr++strNull :: Str -> Bool+strNull = T.null . fromStr++bstrPack :: String -> BStr+bstrPack = US.fromString++bstrUnpack :: BStr -> String+bstrUnpack = US.toString++bstrReadFile :: FilePath -> IO BStr+bstrReadFile = BS.readFile++bstrSplitInfix :: BStr -> BStr -> Maybe (BStr, BStr)+bstrSplitInfix needle haystack+    | (a,b) <- BS.breakSubstring needle haystack+    , not $ BS.null b+    = Just (a, BS.drop (BS.length needle) b)+bstrSplitInfix _ _ = Nothing++bstrNull :: BStr -> Bool+bstrNull = BS.null++bstrStripPrefix :: BStr -> BStr -> Maybe BStr+bstrStripPrefix needle x+    | BS.isPrefixOf needle x = Just $ BS.drop (BS.length needle) x+    | otherwise = Nothing++bstrTrimStart :: BStr -> BStr+bstrTrimStart = BS.dropWhile isSpace++lbstrToChunks :: LBStr -> [BStr]+lbstrToChunks = LBS.toChunks++lbstrFromChunks :: [BStr] -> LBStr+lbstrFromChunks = LBS.fromChunks++lbstrUnpack :: LBStr -> String+lbstrUnpack = LUS.toString++lbstrPack :: String -> LBStr+lbstrPack = LUS.fromString+++type BStr0 = BStr++bstr0Join :: [String] -> BStr0+bstr0Join = LBS.toStrict . LUS.fromString . intercalate "\0"++bstr0Split :: BStr0 -> [BStr]+bstr0Split = BS.split '\0'
− src/General/System.hs 
@@ -1,85 +0,0 @@-{-# LANGUAGE CPP, ScopedTypeVariables #-}---- | Module for system like things in base/directory/etc, or could plausibly be added.-module General.System(module General.System, module X) where--import System.Process as X-import System.Directory as X-import System.Environment as X-import System.Exit as X-import System.IO as X-import System.Mem as X (performGC)--import General.Base-import qualified Control.Exception as E--#if __GLASGOW_HASKELL__ >= 612-import GHC.IO.Handle(hDuplicate,hDuplicateTo)-#endif--#ifndef mingw32_HOST_OS-import System.Posix(setFileCreationMask)-#else-setFileCreationMask :: Int -> IO Int-setFileCreationMask _ = return 0-#endif---isWindows :: Bool-#ifdef mingw32_HOST_OS-isWindows = True-#else-isWindows = False-#endif---removeFile_ x = removeFile x `E.catch` \(_ :: E.SomeException) -> return ()---withDirectory dir cmd = E.bracket-    (do x <- getCurrentDirectory; setCurrentDirectory dir; return x)-    setCurrentDirectory-    (const cmd)---withModeGlobalRead :: IO () -> IO ()-withModeGlobalRead act = E.bracket-    (setFileCreationMask 0o022)-    (\x -> setFileCreationMask x >> return ())-    (const act)----- FIXME: This could use a lot more bracket calls!-captureOutput :: IO () -> IO (Maybe String)-#if __GLASGOW_HASKELL__ < 612-captureOutput act = return Nothing-#else-captureOutput act = do-    tmp <- getTemporaryDirectory-    (f,h) <- openTempFile tmp "hoogle"-    sto <- hDuplicate stdout-    ste <- hDuplicate stderr-    hDuplicateTo h stdout-    hDuplicateTo h stderr-    hClose h-    act-    hDuplicateTo sto stdout-    hDuplicateTo ste stderr-    res <- readFile' f-    removeFile f-    return $ Just res-#endif---system_ :: String -> IO ()-system_ x = do-    res <- system x-    when (res /= ExitSuccess) $ error $ "System command failed: " ++ x---exitMessage :: [String] -> IO a-exitMessage msg = putStr (unlines msg) >> exitFailure---getEnvVar :: String -> IO (Maybe String)-getEnvVar x = E.catch (fmap Just $ getEnv x) (\(x :: E.SomeException) -> return Nothing)
+ src/General/Template.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE PatternGuards, DeriveDataTypeable, ScopedTypeVariables #-}++module General.Template(+    Template, templateFile, templateMarkup, templateApply, templateRender+    ) where++import Data.Data+import Data.Monoid+import Text.Blaze+import Text.Blaze.Renderer.Utf8+import General.Str+import Data.List.Extra+import Control.Exception+import Data.Generics.Uniplate.Data+import Control.Applicative+import System.IO.Unsafe+import System.Directory+import Control.Monad+import Data.IORef+import Prelude++---------------------------------------------------------------------+-- TREE DATA TYPE++data Tree = Lam FilePath -- #{foo} defines a lambda+          | Var BStr -- a real variable+          | App Tree [(BStr, Tree)] -- applies a foo string to the lambda+          | Lit BStr+          | List [Tree]+            deriving (Typeable,Data,Show)+++-- | Turn all Lam into Var/Lit+treeRemoveLam :: Tree -> IO Tree+treeRemoveLam = transformM f+    where+        f (Lam file) = List . parse <$> bstrReadFile file+        f x = pure x++        parse x | Just (a,b) <- bstrSplitInfix (bstrPack "#{") x+                , Just (b,c) <- bstrSplitInfix (bstrPack "}") b+                = Lit a : Var b : parse c+        parse x = [Lit x]++treeRemoveApp :: Tree -> Tree+treeRemoveApp = f []+    where+        f seen (App t xs) = f (xs ++ seen) t+        f seen (Var x) | Just t <- lookup x seen = f seen t+        f seen x = descend (f seen) x++treeOptimise :: Tree -> Tree+treeOptimise = transform f . treeRemoveApp+    where+        fromList (List xs) = xs; fromList x = [x]+        toList [x] = x; toList xs = List xs+        isLit (Lit x) = True; isLit _ = False+        fromLit (Lit x) = x++        f = toList . g . concatMap fromList . fromList++        g [] = []+        g (x:xs) | not $ isLit x = x : g xs+        g xs = [Lit x | let x = mconcatMap fromLit a, x /= mempty] ++ g b+            where (a,b) = span isLit xs++treeEval :: Tree -> [BStr]+treeEval = f . treeRemoveApp+    where f (Lit x) = [x]+          f (List xs) = concatMap f xs+          f _ = []+++---------------------------------------------------------------------+-- TEMPLATE DATA TYPE++-- a tree, and a pre-optimised tree you can create+data Template = Template Tree (IO Tree)++{-# NOINLINE treeCache #-}+treeCache :: Tree -> IO Tree+treeCache t0 = unsafePerformIO $ do+    let files = [x | Lam x <- universe t0]+    ref <- newIORef ([], treeOptimise t0)+    pure $ do+        (old,t) <- readIORef ref+        new <- forM files $ \file ->+            -- the standard getModificationTime message on Windows doesn't say the file+            getModificationTime file `catch` \(e :: IOException) ->+                fail $ "Failed: getModificationTime on " ++ file ++ ", " ++ show e+        if old == new then pure t else do+            t <- treeOptimise <$> treeRemoveLam t0+            writeIORef ref (new,t)+            pure t++templateTree :: Tree -> Template+templateTree t = Template t $ treeCache t++templateFile :: FilePath -> Template+templateFile = templateTree . Lam++templateMarkup :: Markup -> Template+templateMarkup = templateStr . renderMarkup++templateStr :: LBStr -> Template+templateStr = templateTree . List . map Lit . lbstrToChunks++templateApply :: Template -> [(String, Template)] -> Template+templateApply (Template t _) args = templateTree $ App t [(bstrPack a, b) | (a,Template b _) <- args]++templateRender :: Template -> [(String, Template)] -> IO LBStr+templateRender (Template _ t) args = do+    t <- t+    let Template t2 _ = templateApply (Template t $ pure t) args+    lbstrFromChunks . treeEval <$> treeRemoveLam t2
+ src/General/Timing.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE RecordWildCards #-}++module General.Timing(Timing, withTiming, timed, timedOverwrite) where++import Data.List.Extra+import System.Time.Extra+import Data.IORef+import Control.Monad.Extra+import System.IO+import General.Util+import Control.Monad.IO.Class++-- | A mutable object to keep timing information+data Timing = Timing+    { -- | Get time since the initialization of this 'Timing'.+      timingOffset :: IO Seconds+      -- | Record timings for writing to a file+    , timingStore :: IORef [(String, Seconds)]+      -- | If you are below T you may overwrite N characters+      -- at the end of the current terminal output.+      -- Only used iff @timingTerminal == True@.+    , timingOverwrite :: IORef (Maybe (Seconds, Int))+      -- | whether is this a terminal+    , timingTerminal :: Bool+    }++-- | Time an action, printing timing information to the terminal+withTiming ::+  -- | A file to optionally write all timings to, after the action is finished+  Maybe FilePath ->+  -- | An action that can write timings into 'Timing'+  (Timing -> IO a) ->+  IO a+withTiming writeTimingsTo act = do+    timingOffset <- offsetTime+    timingStore <- newIORef []+    timingOverwrite <- newIORef Nothing+    timingTerminal <- hIsTerminalDevice stdout++    res <- act Timing{..}+    total <- timingOffset+    whenJust writeTimingsTo $ \file -> do+        xs <- readIORef timingStore+        -- Expecting unrecorded of ~2s+        -- Most of that comes from the pipeline - we get occasional 0.01 between items as one flushes+        -- Then at the end there is ~0.5 while the final item flushes+        xs <- pure $ sortOn (negate . snd) $ ("Unrecorded", total - sum (map snd xs)) : xs+        writeFile file $ unlines $ prettyTable 2 "Secs" xs+    putStrLn $ "Took " ++ showDuration total+    pure res+++-- skip it if have written out in the last 1s and takes < 0.1++-- | Time & write the given message to stdout+timed :: MonadIO m => Timing -> String -> m a -> m a+timed = timedEx False++-- | Time & write the given message to stdout+-- overwriting a previous message if it was marked as overwritable+timedOverwrite :: MonadIO m => Timing -> String -> m a -> m a+timedOverwrite = timedEx True++timedEx :: MonadIO m => Bool -> Timing -> String -> m a -> m a+timedEx overwrite Timing{..} msg act = do+    start <- liftIO timingOffset+    liftIO $ whenJustM (readIORef timingOverwrite) $ \(t,n) ->+        if overwrite && start < t then+            putStr $ replicate n '\b' ++ replicate n ' ' ++ replicate n '\b'+        else+            putStrLn ""++    let out msg = liftIO $ putStr msg >> pure (length msg)+    undo1 <- out $ msg ++ "... "+    liftIO $ hFlush stdout++    res <- act+    end <- liftIO timingOffset+    let time = end - start+    liftIO $ modifyIORef timingStore ((msg,time):)++    s <- maybe "" (\x -> " (" ++ x ++ ")") <$> liftIO getStatsPeakAllocBytes+    undo2 <- out $ showDuration time ++ s++    old <- liftIO $ readIORef timingOverwrite+    let next = maybe (start + 1.0) fst old+    liftIO $ if timingTerminal && overwrite && end < next then+        writeIORef timingOverwrite $ Just (next, undo1 + undo2)+     else do+        writeIORef timingOverwrite Nothing+        putStrLn ""+    pure res
− src/General/TypeMap.hs 
@@ -1,41 +0,0 @@-{-# LANGUAGE CPP #-}--module General.TypeMap(-    TypeMap, empty,-    lookup, insert, find-    ) where--import Prelude hiding (lookup)-import Data.Dynamic-import Data.Maybe-import qualified Data.Map as Map--newtype TypeMap = TypeMap (Map.Map TypeRep Dynamic)---empty :: TypeMap-empty = TypeMap Map.empty---lookup :: Typeable a => TypeMap -> Maybe a-lookup (TypeMap mp) = res-    where res = fmap (fromJust . fromDynamic) $ Map.lookup (typeOf $ fromJust res) mp---find :: Typeable a => TypeMap -> a-find mp = res-    where res = fromMaybe (error msg) $ lookup mp-          msg = "General.TypeMap.find, couldn't find " ++ show (typeOf res)---insert :: Typeable a => a -> TypeMap -> TypeMap-insert a (TypeMap mp) = TypeMap $ Map.insert (typeOf a) (toDyn a) mp---#if __GLASGOW_HASKELL__ < 702-instance Ord TypeRep where-    compare a b = compare (splitTyConApp a) (splitTyConApp b)--instance Ord TyCon where-    compare a b = compare (tyConString a) (tyConString b)-#endif
src/General/Util.hs view
@@ -1,132 +1,385 @@+{-# LANGUAGE PatternGuards, ViewPatterns, CPP, ScopedTypeVariables #-} -module General.Util where+module General.Util(+    PkgName, ModName,+    URL,+    pretty, parseMode, applyType, applyFun1, unapplyFun, fromName, fromQName, fromTyVarBind, declNames, isTypeSig,+    fromDeclHead, fromContext, fromIParen, fromInstHead,+    tarballReadFiles,+    isUpper1, isAlpha1,+    joinPair,+    testing, testEq,+    showUTCTime,+    strict,+    withs,+    escapeHTML, unescapeHTML, unHTML,+    escapeURL,+    takeSortOn,+    Average, toAverage, fromAverage,+    inRanges,+    parseTrailingVersion,+    trimVersion,+    exitFail,+    prettyTable,+    getStatsPeakAllocBytes, getStatsCurrentLiveBytes, getStatsDebug,+    hackagePackageURL, hackageModuleURL, hackageDeclURL, ghcModuleURL,+    minimum', maximum',+    general_util_test+    ) where -import General.Base-import qualified Data.Set as Set+import Language.Haskell.Exts+import Control.Applicative+import Data.List.Extra+import Data.Char+import Data.Either.Extra+import Data.Semigroup+import Data.Tuple.Extra+import Control.Monad.Extra+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Map as Map+import Data.Ix+import Numeric.Extra+import Codec.Compression.GZip as GZip+import Codec.Archive.Tar as Tar+import Data.Time.Clock+import Data.Time.Format+import Control.DeepSeq+import Control.Exception.Extra+import Test.QuickCheck+import Data.Version+import Data.Int+import System.IO+import System.Exit+import System.Mem+import GHC.Stats+import General.Str+import Prelude+import qualified Network.HTTP.Types.URI as URI+import qualified Data.ByteString.UTF8 as UTF8+import Distribution.Types.PackageName (PackageName, unPackageName) -nubOrdOn :: Ord k => (a -> k) -> [a] -> [a]-nubOrdOn op = f Set.empty-    where f mp [] = []-          f mp (x:xs) | op x `Set.member` mp = f mp xs-                      | otherwise = x : f (Set.insert (op x) mp) xs -nubOrd :: Ord a => [a] -> [a]-nubOrd = nubOrdOn id+type PkgName = PackageName+type ModName = Str +-- | A URL, complete with a @https:@ prefix.+type URL = String --- | Only append strings if neither one is empty-(++?) :: String -> String -> String-a ++? b = if null a || null b then [] else a ++ b+#if __GLASGOW_HASKELL__ >= 802+#define RTS_STATS 1+#endif -groupOn f = groupBy ((==) `on` f)-nubOn f = nubBy ((==) `on` f)+showMb :: (Show a, Integral a) => a -> String+#if RTS_STATS+showMb x = show (x `div` (1024*1024)) ++ "Mb"+#else+showMb x = show x ++ "Mb"+#endif -sortFst mr = sortOn fst mr-groupFst mr = groupOn fst mr +#if RTS_STATS+withRTSStats :: (RTSStats -> a) -> IO (Maybe a)+withRTSStats f = ifM getRTSStatsEnabled (Just . f <$> getRTSStats) (pure Nothing)+#else+withGCStats :: (GCStats -> a) -> IO (Maybe a)+withGCStats f = ifM getGCStatsEnabled (Just . f <$> getGCStats) (pure Nothing)+#endif -groupFsts :: Eq k => [(k,v)] -> [(k,[v])]-groupFsts = map (fst . head &&& map snd) . groupFst+getStatsCurrentLiveBytes :: IO (Maybe String)+getStatsCurrentLiveBytes = do+    performGC+#if RTS_STATS+    withRTSStats $ showMb . gcdetails_live_bytes . gc+#else+    withGCStats $ showMb . currentBytesUsed+#endif -sortGroupFsts mr = groupFsts . sortFst $ mr-sortGroupFst mr = groupFst . sortFst $ mr+getStatsPeakAllocBytes :: IO (Maybe String)+getStatsPeakAllocBytes = do+#if RTS_STATS+    withRTSStats $ showMb . max_mem_in_use_bytes+#else+    withGCStats $ showMb . peakMegabytesAllocated+#endif +getStatsDebug :: IO (Maybe String)+getStatsDebug = do+    let dump = replace ", " "\n" . takeWhile (/= '}') . drop1 . dropWhile (/= '{') . show+#if RTS_STATS+    withRTSStats dump+#else+    withGCStats dump+#endif -fold :: a -> (a -> a -> a) -> [a] -> a-fold x f [] = x-fold x f xs = fold1 f xs  -fold1 :: (a -> a -> a) -> [a] -> a-fold1 f [x] = x-fold1 f xs = f (fold1 f a) (fold1 f b)-    where (a,b) = halves xs+exitFail :: String -> IO ()+exitFail msg = do+    hPutStrLn stderr msg+    exitFailure +pretty :: Pretty a => a -> String+pretty = prettyPrintWithMode defaultMode{layout=PPNoLayout} -halves :: [a] -> ([a],[a])-halves [] = ([], [])-halves (x:xs) = (x:b,a)-    where (a,b) = halves xs +parseMode :: ParseMode+parseMode = defaultParseMode{extensions=map EnableExtension es}+    where es = [ConstraintKinds,EmptyDataDecls,TypeOperators,ExplicitForAll,GADTs,KindSignatures,MultiParamTypeClasses+               ,TypeFamilies,FlexibleContexts,FunctionalDependencies,ImplicitParams,MagicHash,UnboxedTuples+               ,ParallelArrays,UnicodeSyntax,DataKinds,PolyKinds,PatternSynonyms] -merge :: Ord a => [a] -> [a] -> [a]-merge xs [] = xs-merge [] ys = ys-merge (x:xs) (y:ys)-    | x <= y = x : merge xs (y:ys)-    | otherwise = y : merge (x:xs) ys+applyType :: Type a -> [Type a] -> Type a+applyType x (t:ts) = applyType (TyApp (ann t) x t) ts+applyType x [] = x +applyFun1 :: [Type a] -> Type a+applyFun1 [x] = x+applyFun1 (x:xs) = TyFun (ann x) x $ applyFun1 xs -mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]-mergeBy f xs [] = xs-mergeBy f [] ys = ys-mergeBy f (x:xs) (y:ys)-    | f x y /= GT = x : mergeBy f xs (y:ys)-    | otherwise = y : mergeBy f (x:xs) ys+unapplyFun :: Type a -> [Type a]+unapplyFun (TyFun _ x y) = x : unapplyFun y+unapplyFun x = [x]  -merges :: Ord a => [[a]] -> [a]-merges = fold [] merge+fromName :: Name a -> String+fromName (Ident _ x) = x+fromName (Symbol _ x) = x -mergesBy :: (a -> a -> Ordering) -> [[a]] -> [a]-mergesBy f = fold [] (mergeBy f)+fromQName :: QName a -> String+fromQName (Qual _ _ x) = fromName x+fromQName (UnQual _ x) = fromName x+fromQName (Special _ UnitCon{}) = "()"+fromQName (Special _ ListCon{}) = "[]"+fromQName (Special _ FunCon{}) = "->"+fromQName (Special _ (TupleCon _ box n)) = "(" ++ h ++ replicate n ',' ++ h ++ ")"+    where h = ['#' | box == Unboxed]+fromQName (Special _ UnboxedSingleCon{}) = "(##)"+fromQName (Special _ Cons{}) = ":" +fromContext :: Context a -> [Asst a]+fromContext (CxSingle _ x) = [x]+fromContext (CxTuple _ xs) = xs+fromContext _ = [] -split :: Eq a => a -> [a] -> [[a]]-split x [] = []-split x xs = if null b then [a] else a : split x (tail b)-    where (a,b) = break (== x) xs+fromIParen :: InstRule a -> InstRule a+fromIParen (IParen _ x) = fromIParen x+fromIParen x = x +fromTyVarBind :: TyVarBind a -> Name a+fromTyVarBind (KindedVar _ x _) = x+fromTyVarBind (UnkindedVar _ x) = x -rep from to x = if x == from then to else x-reps from to = map (rep from to)+fromDeclHead :: DeclHead a -> (Name a, [TyVarBind a])+fromDeclHead (DHead _ n) = (n, [])+fromDeclHead (DHInfix _ x n) = (n, [x])+fromDeclHead (DHParen _ x) = fromDeclHead x+fromDeclHead (DHApp _ dh x) = second (++[x]) $ fromDeclHead dh +fromInstHead :: InstHead a -> (QName a, [Type a])+fromInstHead (IHCon _ n) = (n, [])+fromInstHead (IHInfix _ x n) = (n, [x])+fromInstHead (IHParen _ x) = fromInstHead x+fromInstHead (IHApp _ ih x) = second (++[x]) $ fromInstHead ih --- | 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+declNames :: Decl a -> [String]+declNames x = map fromName $ case x of+    TypeDecl _ hd _ -> f hd+    DataDecl _ _ _ hd _ _ -> f hd+    GDataDecl _ _ _ hd _ _ _ -> f hd+    TypeFamDecl _ hd _ _ -> f hd+    DataFamDecl _ _ hd _ -> f hd+    ClassDecl _ _ hd _ _ -> f hd+    TypeSig _ names _ -> names+    PatSynSig _ names _ _ _ _ _ -> names+    _ -> []+    where f x = [fst $ fromDeclHead x]+++isTypeSig :: Decl a -> Bool+isTypeSig TypeSig{} = True+isTypeSig PatSynSig{} = True+isTypeSig _ = False+++tarballReadFiles :: FilePath -> IO [(FilePath, LBS.ByteString)]+tarballReadFiles file = f . Tar.read . GZip.decompress <$> LBS.readFile file     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+        f (Next e rest) | NormalFile body _ <- entryContent e = (entryPath e, body) : f rest+        f (Next _ rest) = f rest+        f Done = []+        f (Fail e) = error $ "tarballReadFiles on " ++ file ++ ", " ++ show e  -rbreak f xs = case break f $ reverse xs of-    (_, []) -> (xs, [])-    (as, b:bs) -> (reverse bs, b:reverse as)+innerTextHTML :: String -> String+innerTextHTML ('<':xs) = innerTextHTML $ drop1 $ dropWhile (/= '>') xs+innerTextHTML (x:xs) = x : innerTextHTML xs+innerTextHTML [] = [] +unHTML :: String -> String+unHTML = unescapeHTML . innerTextHTML -compareCaseless :: String -> String -> Ordering-compareCaseless x = compare (map toLower x) . map toLower+escapeURL :: String -> String+escapeURL = UTF8.toString . URI.urlEncode True . UTF8.fromString +isUpper1 (x:xs) = isUpper x+isUpper1 _ = False --- compare strings, but with an ordering that puts 'a' < 'A' < 'b' < 'B'-compareString :: String -> String -> Ordering-compareString (x:xs) (y:ys) = case compareChar x y of-    EQ -> compareString xs ys-    x -> x-compareString [] [] = EQ-compareString xs ys = if null xs then LT else GT+isAlpha1 (x:xs) = isAlpha x+isAlpha1 [] = False +splitPair :: String -> String -> (String, String)+splitPair x y | (a,stripPrefix x -> Just b) <- breakOn x y = (a,b)+              | otherwise = error $ "splitPair does not contain separator " ++ show x ++ " in " ++ show y -compareChar :: Char -> Char -> Ordering-compareChar x y = case (compare x y, compare (toLower x) (toLower y)) of-    (EQ, _) -> EQ-    (x, EQ) -> if x == GT then LT else GT-    (_, x ) -> x+joinPair :: [a] -> ([a], [a]) -> [a]+joinPair sep (a,b) = a ++ sep ++ b +testing_, testing :: String -> IO () -> IO ()+testing_ name act = do putStr $ "Test " ++ name ++ " "; act+testing name act = do testing_ name act; putStrLn "" -findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)-findM p [] = return Nothing-findM p (x:xs) = do-    v <- p x-    if v then return $ Just x else findM p xs+testEq :: (Show a, Eq a) => a -> a -> IO ()+testEq a b | a == b = putStr "."+           | otherwise = errorIO $ "Expected equal, but " ++ show a ++ " /= " ++ show b -partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])-partitionM f [] = return ([], [])-partitionM f (x:xs) = do-    res <- f x-    (as,bs) <- partitionM f xs-    return ([x | res]++as, [x | not res]++bs)+showUTCTime :: String -> UTCTime -> String+showUTCTime = formatTime defaultTimeLocale+++withs :: [(a -> r) -> r] -> ([a] -> r) -> r+withs [] act = act []+withs (f:fs) act = f $ \a -> withs fs $ \as -> act $ a:as+++prettyTable :: Int -> String -> [(String, Double)] -> [String]+prettyTable dp units xs =+    ( padR len units ++ "\tPercent\tName") :+    [ padL len (showDP dp b) ++ "\t" ++ padL 7 (showDP 1 (100 * b / tot) ++ "%") ++ "\t" ++ a+    | (a,b) <- ("Total", tot) : sortOn (negate . snd) xs]+    where+        tot = sum $ map snd xs+        len = length units `max` length (showDP dp tot)++        padL n s = replicate (n - length s) ' ' ++ s+        padR n s = s ++ replicate (n - length s) ' '++-- ensure that no value escapes in a thunk from the value+strict :: NFData a => IO a -> IO a+strict act = do+    res <- try_ act+    case res of+        Left e -> do msg <- showException e; evaluate $ rnf msg; errorIO msg+        Right v -> evaluate $ force v++data Average a = Average !a {-# UNPACK #-} !Int deriving Show -- a / b++toAverage :: a -> Average a+toAverage x = Average x 1++fromAverage :: Fractional a => Average a -> a+fromAverage (Average a b) = a / fromIntegral b++instance Num a => Semigroup (Average a) where+    Average x1 x2 <> Average y1 y2 = Average (x1+y1) (x2+y2)++instance Num a => Monoid (Average a) where+    mempty = Average 0 0+    mappend = (<>)+++data TakeSort k v = More !Int !(Map.Map k [v])+                  | Full !k !(Map.Map k [v])++-- | @takeSortOn n op == take n . sortOn op@+takeSortOn :: Ord k => (a -> k) -> Int -> [a] -> [a]+takeSortOn op n xs+    | n <= 0 = []+    | otherwise = concatMap reverse $ Map.elems $ getMap $ foldl' add (More n Map.empty) xs+    where+        getMap (More _ mp) = mp+        getMap (Full _ mp) = mp++        add (More n mp) x = (if n <= 1 then full else More (n-1)) $ Map.insertWith (++) (op x) [x] mp+        add o@(Full mx mp) x = let k = op x in if k >= mx then o else full $ Map.insertWith (++) k [x] $ delMax mp+        full mp = Full (fst $ Map.findMax mp) mp+        delMax mp | Just ((k,_:vs), mp) <- Map.maxViewWithKey mp = if null vs then mp else Map.insert k vs mp++++-- See https://ghc.haskell.org/trac/ghc/ticket/10830 - they broke maximumBy+maximumBy' :: (a -> a -> Ordering) -> [a] -> a+maximumBy' cmp = foldl1' $ \x y -> if cmp x y == GT then x else y++maximum' :: Ord a => [a] -> a+maximum' = maximumBy' compare++minimumBy' :: (a -> a -> Ordering) -> [a] -> a+minimumBy' cmp = foldl1' $ \x y -> if cmp x y == LT then x else y++minimum' :: Ord a => [a] -> a+minimum' = minimumBy' compare+++hackagePackageURL :: PkgName -> URL+hackagePackageURL x = "https://hackage.haskell.org/package/" ++ unPackageName x++hackageModuleURL :: ModName -> URL+hackageModuleURL x = "/docs/" ++ ghcModuleURL x++ghcModuleURL :: ModName -> URL+ghcModuleURL x = replace "." "-" (strUnpack x) ++ ".html"++hackageDeclURL :: Bool -> String -> URL+hackageDeclURL typesig x = "#" ++ (if typesig then "v" else "t") ++ ":" ++ concatMap f x+    where+        f x | isLegal x = [x]+            | otherwise = "-" ++ show (ord x) ++ "-"+        -- isLegal is from haddock-api:Haddock.Utils; we need to use+        -- the same escaping strategy here in order for fragment links+        -- to work+        isLegal ':' = True+        isLegal '_' = True+        isLegal '.' = True+        isLegal c = isAscii c && isAlphaNum c+++trimVersion :: Int -> Version -> Version+trimVersion i v = v{versionBranch = take 3 $ versionBranch v}++parseTrailingVersion :: String -> (String, [Int])+parseTrailingVersion = (reverse *** reverse) . f . reverse+    where+        f xs | (ver@(_:_),sep:xs) <- span isDigit xs+             , sep == '-' || sep == '.'+             , (a, b) <- f xs+             = (a, Prelude.read (reverse ver) : b)+        f xs = (xs, [])+++-- | Equivalent to any (`inRange` x) xs, but more efficient+inRanges :: Ix a => [(a,a)] -> (a -> Bool)+inRanges xs = \x -> maybe False (`inRange` x) $ Map.lookupLE x mp+    where+        mp = foldl' add Map.empty xs++        merge (l1,u1) (l2,u2) = (min l1 l2, max u1 u2)+        overlap x1 x2 = x1 `inRange` fst x2 || x2 `inRange` fst x1+        add mp x+            | Just x2 <- Map.lookupLE (fst x) mp, overlap x x2 = add (Map.delete (fst x2) mp) (merge x x2)+            | Just x2 <- Map.lookupGE (fst x) mp, overlap x x2 = add (Map.delete (fst x2) mp) (merge x x2)+            | otherwise = uncurry Map.insert x mp+++general_util_test :: IO ()+general_util_test = do+    testing "General.Util.splitPair" $ do+        let a === b = if a == b then putChar '.' else errorIO $ show (a,b)+        splitPair ":" "module:foo:bar" === ("module","foo:bar")+        do x <- try_ $ evaluate $ rnf $ splitPair "-" "module:foo"; isLeft x === True+        splitPair "-" "module-" === ("module","")+    testing_ "General.Util.inRanges" $ do+        quickCheck $ \(x :: Int8) xs -> inRanges xs x == any (`inRange` x) xs+    testing "General.Util.parseTrailingVersion" $ do+        let a === b = if a == b then putChar '.' else errorIO $ show (a,b)+        parseTrailingVersion "shake-0.15.2" === ("shake",[0,15,2])+        parseTrailingVersion "test-of-stuff1" === ("test-of-stuff1",[])
src/General/Web.hs view
@@ -1,196 +1,207 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE PatternGuards #-}-{-# OPTIONS_GHC -fno-warn-unused-imports #-} -- becomes confusing with all the CPP--{- |-    General web utility functions.--}+{-# LANGUAGE ScopedTypeVariables, OverloadedStrings, ViewPatterns, RecordWildCards, DeriveFunctor #-}  module General.Web(-    responseOK, responseNotFound,-    responseFlatten, responseEvaluate, responseRewrite,-    URL, filePathToURL, combineURL, escapeURL, (++%), unescapeURL,-    escapeHTML, (++&), htmlTag,-    Args, cgiArgs, cgiResponse, parseHttpQueryArgs+    Input(..),+    Output(..), readInput, server, general_web_test     ) where -#ifndef MIN_VERSION_wai-#define MIN_VERSION_wai(a,b,c) 1-#endif+import Network.Wai.Handler.Warp hiding (Port, Handle)+import Network.Wai.Handler.WarpTLS -import General.System-import General.Base-import System.FilePath+import Action.CmdLine+import Network.Wai.Logger import Network.Wai-#if MIN_VERSION_wai(3, 0, 0)-import Data.IORef-#endif-#if MIN_VERSION_wai(2, 0, 0)-import Network.Wai.Internal-#endif-import Network.HTTP.Types-import Data.CaseInsensitive(original)+import Control.DeepSeq+import Network.HTTP.Types (parseQuery, decodePathSegments)+import Network.HTTP.Types.Status+import qualified Data.Text as Text+import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS--import Blaze.ByteString.Builder(toLazyByteString)-import Data.Conduit.List(consume)-import Data.Conduit(($$),Flush(Chunk))-#if !MIN_VERSION_wai(2, 0, 0)-import Control.Monad.Trans.Resource (runResourceT)-#endif--type Args = [(String, String)]--------------------------------------------------------------------------- WAI STUFF--responseOK = responseLBS status200-responseNotFound x = responseLBS status404 [] $ fromString $ "File not found: " ++ x--responseFlatten :: Response -> IO (Status, ResponseHeaders, LBString)-responseFlatten r = do-#if MIN_VERSION_wai(3, 0, 0)-    let (s,hs,withBody) = responseToStream r-    ref <- newIORef mempty-    let addChunk builder = modifyIORef ref (<> builder)-    withBody $ \body -> body addChunk (return ())-    builder <- readIORef ref-    let res = toLazyByteString builder-    return (s,hs,res)-#elif MIN_VERSION_wai(2, 0, 0)-    let (s,hs,withSrc) = responseToSource r-    chunks <- withSrc $ \src -> src $$ consume-    let res = toLazyByteString $ mconcat [x | Chunk x <- chunks]-    return (s,hs,res)-#else-    let (s,hs,rest) = responseSource r-    chunks <- runResourceT $ rest $$ consume-    let res = toLazyByteString $ mconcat [x | Chunk x <- chunks]-    return (s,hs,res)-#endif---responseEvaluate :: Response -> IO ()-responseEvaluate (ResponseBuilder _ _ x) = LBS.length (toLazyByteString x) `seq` return ()-responseEvaluate _ = return ()---responseRewrite :: (LBString -> LBString) -> Response -> IO Response-responseRewrite f r = do-    (a,b,c) <- responseFlatten r-    return $ responseLBS a b $ f c--------------------------------------------------------------------------- HTML STUFF---- | Take a piece of text and escape all the HTML special bits-escapeHTML :: String -> String-escapeHTML = concatMap f-    where-        f '<' = "&lt;"-        f '>' = "&gt;"-        f '&' = "&amp;"-        f '\"' = "&quot;"-        f  x  = [x]----- | Escape the second argument as HTML before appending-(++&) :: String -> String -> String-a ++& b = a ++ escapeHTML b---htmlTag :: String -> String -> String-htmlTag x y = "<" ++ x ++ ">" ++ y ++ "</" ++ x ++ ">"--------------------------------------------------------------------------- URL STUFF--filePathToURL :: FilePath -> URL-filePathToURL xs = "file://" ++ ['/' | not $ "/" `isPrefixOf` ys] ++ ys-    where ys = map (\x -> if isPathSeparator x then '/' else x) xs---combineURL :: String -> String -> String-combineURL a b-    | any (`isPrefixOf` b) ["http:","https:","file:"] = b-    | otherwise = a ++ b----- | Take an escape encoded string, and return the original-unescapeURL :: String -> String-unescapeURL ('+':xs) = ' ' : unescapeURL xs-unescapeURL ('%':a:b:xs) | [(v,"")] <- readHex [a,b] = chr v : unescapeURL xs-unescapeURL (x:xs) = x : unescapeURL xs-unescapeURL [] = []+import Data.List.Extra+import Data.Aeson.Encoding+import Data.Char+import Data.String+import Data.Tuple.Extra+import Data.Maybe+import Data.Monoid+import System.FilePath+import Control.Exception.Extra+import System.Time.Extra+import General.Log+import General.Util+import Prelude+import qualified Data.ByteString.UTF8 as UTF8  -escapeURL :: String -> String-escapeURL = concatMap f-    where-        f x | isAlphaNum x || x `elem` "-" = [x]-            | x == ' ' = "+"-            | otherwise = '%' : ['0' | length s == 1] ++ s-            where s = showHex (ord x) ""-+data Input = Input+    {inputURL :: [String]+    ,inputArgs :: [(String, String)]+    } deriving (Eq, Show) --- | Escape the second argument as a CGI query string before appending-(++%) :: String -> String -> String-a ++% b = a ++ escapeURL b+readInput :: String -> Maybe Input+readInput (breakOn "?" -> (a,b)) =+  if (badPath path || badArgs args) then Nothing else Just $ Input path args+  where+    path = parsePath a+    parsePath = map Text.unpack+              . decodePathSegments+              . BS.pack+    -- Note that there is a difference between URL paths+    -- which split on / and only that and file paths where+    -- an escaped %2f is equivalent to /. decodePathSegments+    -- (correctly) only considers the former so here+    -- we add an extra check that the result (which has unescaped %2f to /)+    -- does not contain path separators.+    badPath = any badSegment . filter (/= "")+    badSegment seg = all (== '.') seg || any isPathSeparator seg+    args = parseArgs b+    parseArgs = map (UTF8.toString *** maybe "" UTF8.toString)+              . parseQuery+              . UTF8.fromString+    badArgs = not . all (all isLower . fst) ------------------------------------------------------------------------- CGI STUFF+data Output+    = OutputText LBS.ByteString+    | OutputHTML LBS.ByteString+    | OutputJavascript LBS.ByteString+    | OutputJSON Encoding+    | OutputFail LBS.ByteString+    | OutputFile FilePath+      deriving Show --- The BOA server does not set QUERY_STRING if it would be blank.--- However, it does always set REQUEST_URI.-cgiVariable :: IO (Maybe String)-cgiVariable = do-    str <- getEnvVar "QUERY_STRING"-    if isJust str-        then return str-        else fmap (fmap $ const "") $ getEnvVar "REQUEST_URI"+-- | Force all the output (no delayed exceptions) and produce bytestrings+forceBS :: Output -> LBS.ByteString+forceBS (OutputText x) = force x+forceBS (OutputJSON x) = force $ encodingToLazyByteString x+forceBS (OutputHTML x) = force x+forceBS (OutputJavascript x) = force x+forceBS (OutputFail x) = force x+forceBS (OutputFile x) = rnf x `seq` LBS.empty +instance NFData Output where+    rnf x = forceBS x `seq` () -cgiArgs :: IO (Maybe Args)-cgiArgs = do-    x <- cgiVariable-    return $ case x of-        Nothing -> Nothing-        Just y -> Just $ parseHttpQueryArgs $ ['=' | '=' `notElem` y] ++ y+server :: Log -> CmdLine -> (Input -> IO Output) -> IO ()+server log Server{..} act = do+    let+        host' = fromString $+                  if host == "" then+                    if local then+                      "127.0.0.1"+                    else+                      "*"+                  else+                    host+        set = setOnExceptionResponse exceptionResponseForDebug+            . setHost host'+            . setPort port $+            defaultSettings+        runServer :: Application -> IO ()+        runServer = if https then runTLS (tlsSettings cert key) set+                             else runSettings set+        secH = if no_security_headers then []+                                      else [+             -- The CSP is giving additional instructions to the browser.+             ("Content-Security-Policy",+              -- For any content type not specifically enumerated in this CSP+              -- (e.g. fonts), the only valid origin is the same as the current+              -- page.+              "default-src 'self';"+              -- As an exception to the default rule, allow scripts from jquery+              -- and the CDN.+              <> " script-src 'self' https://code.jquery.com/ https://rawcdn.githack.com;"+              -- As an exception to the default rule, allow stylesheets from+              -- the CDN. TODO: for now, we are also enabling inline styles,+              -- because it the chosen plugin uses them.+              <> " style-src 'self' 'unsafe-inline' https://rawcdn.githack.com;"+              -- As an exception to the default rule, allow images from the+              -- CDN.+              <> " img-src 'self' https://rawcdn.githack.com;"+              -- Only allow this request in an iframe if the containing page+              -- has the same origin.+              <> " frame-ancestors 'self';"+              -- Forms are only allowed to target addresses under the same+              -- origin as the page.+              <> " form-action 'self';"+              -- Any request originating from this page and specifying http as+              -- its protocol will be automatically upgraded to https.+              <> (if https then " upgrade-insecure-requests;" else mempty)+              -- Do not display http content if the page was loaded under+              -- https.+              <> " block-all-mixed-content"), +             -- Tells the browser this web page should not be rendered inside a+             -- frame, except if the framing page comes from the same origin+             -- (i.e. DNS name + port). This is to thwart invisible, keylogging+             -- framing pages.+             ("X-Frame-Options", "sameorigin"), -cgiResponse :: Response -> IO ()-cgiResponse r = do-    (status,headers,body) <- responseFlatten r-    LBS.putStr $ LBS.unlines $-        [LBS.fromChunks [original a, fromString ": ", b] | (a,b) <- headers] ++-        [fromString "",body]+             -- Tells browsers to trust the Content-Type header and not try to+             -- otherwise guess at response types. In particular, prevents+             -- dangerous browser behaviour that would execute a file loaded+             -- from a <script> or <style> tag despite not having a+             -- text/javascript or text/css Content-Type.+             ("X-Content-Type-Options", "nosniff"), +             -- Browser should try to detect "reflected" XSS attacks, where+             -- some suspicious payload of the request appears in the response.+             -- How browsers do that is unspecified. On detection, browser+             -- should block the page from rendering at all.+             ("X-XSS-Protection", "1; mode=block"), ------------------------------------------------------------------------- HTTP STUFF+             -- Do not include referrer information if user-agent generates a+             -- request from an HTTPS page to an HTTP one. Note: this is+             -- technically redundant as this should be the browser default+             -- behaviour.+             ("Referrer-Policy", "no-referrer-when-downgrade"), -parseHttpQueryArgs :: String -> Args-parseHttpQueryArgs xs = mapMaybe (f . splitPair "=") $ splitList "&" xs-    where f Nothing = Nothing-          f (Just (a,b)) = Just (unescapeURL a, unescapeURL b)+             -- Strict Transport Security (aka HSTS) tells the browser that,+             -- from now on and until max-age seconds have passed, it should+             -- never try to connect to this domain name through unprotected+             -- HTTP. The browser will automatically upgrade any HTTP request+             -- to this domain name to HTTPS, client side, before any network+             -- call happens.+             ("Strict-Transport-Security", "max-age=31536000; includeSubDomains")] +    logAddMessage log $ "Server starting on port " ++ show port ++ " and host/IP " ++ show host' -splitList :: Eq a => [a] -> [a] -> [[a]]-splitList find str = if isJust q then a : splitList find b else [str]-    where-        q = splitPair find str-        Just (a, b) = q+    runServer $ \req reply -> do+        let pq = BS.unpack $ rawPathInfo req <> rawQueryString req+        putStrLn pq+        (time, res) <- duration $ case readInput pq of+            Nothing -> pure $ Right (OutputFail "", LBS.pack $ "Bad URL: " ++ pq)+            Just pay ->+                handle_ (fmap Left . showException) $ do+                    s <- act pay; bs <- evaluate $ forceBS s; pure $ Right (s, bs)+        logAddEntry log (showSockAddr $ remoteHost req) pq time (either Just (const Nothing) res)+        case res of+            Left s -> reply $ responseLBS status500 [] $ LBS.pack s+            Right (v, bs) -> reply $ case v of+                OutputFile file -> responseFile status200+                    ([("content-type",c) | Just c <- [lookup (takeExtension file) contentType]] ++ secH) file Nothing+                OutputText{} -> responseLBS status200 (("content-type","text/plain") : secH) bs+                OutputJSON{} -> responseLBS status200 (("content-type","application/json") : ("access-control-allow-origin","*") : secH) bs+                OutputFail{} -> responseLBS status400 (("content-type","text/plain") : secH) bs+                OutputHTML{} -> responseLBS status200 (("content-type","text/html") : secH) bs+                OutputJavascript{} -> responseLBS status200 (("content-type","text/javascript") : secH) bs +contentType = [(".html","text/html"),(".css","text/css"),(".js","text/javascript")] -splitPair :: Eq a => [a] -> [a] -> Maybe ([a], [a])-splitPair find str = f str-    where-        f [] = Nothing-        f x  | isPrefixOf find x = Just ([], drop (length find) x)-             | otherwise = if isJust q then Just (head x:a, b) else Nothing-                where-                    q = f (tail x)-                    Just (a, b) = q+general_web_test :: IO ()+general_web_test = do+    testing "General.Web.readInput" $ do+        let a === b = if a == b then putChar '.' else errorIO $ show (a,b)+        readInput "abc" === Just (Input ["abc"] [])+        readInput "/abc" === Just (Input ["abc"] [])+        readInput "/abc/" === Just (Input ["abc", ""] [])+        readInput "abc?ab=cd&ef=gh" === Just (Input ["abc"] [("ab", "cd"), ("ef", "gh")])+        readInput "%2fabc" === Nothing+        readInput "%2F" === Nothing+        readInput "def%2fabc" === Nothing+        readInput "." === Nothing+        readInput ".." === Nothing+        readInput "..a" === Just (Input ["..a"] [])+        readInput "../a" === Nothing+        readInput "a/../a" === Nothing+        readInput "%2e" === Nothing+        readInput "%2E" === Nothing
src/Hoogle.hs view
@@ -1,176 +1,50 @@ --- | The Hoogle API. To perform a search you call 'search' with a 'Database' (obtained by 'loadDatabase') and a---   'Query' (obtained by 'parseQuery').+-- | High level Hoogle API module Hoogle(-    -- * Utility types-    TagStr(..), showTagText, showTagANSI, showTagHTML, showTagHTMLWith,-    H.ParseError(..),-    URL,-    H.Language(..),-    -- * Database-    Database, loadDatabase, saveDatabase, createDatabase, mergeDatabase, showDatabase,-    defaultDatabaseLocation,-    -- * Query-    Query, parseQuery, H.renderQuery,-    H.queryDatabases, H.queryPackages, H.querySetPackage,-    -- * Score-    Score, H.scoring,-    -- * Search-    Result(..), search, suggestions, completions, queryExact, H.ItemKind(..)+    Database, withDatabase, searchDatabase, defaultDatabaseLocation,+    Target(..), URL,+    hoogle,+    targetInfo,+    targetResultDisplay     ) where -import Hoogle.Store.All-import General.Base-import General.System-import System.FilePath-import Hoogle.DataBase2.Type-import Hoogle.DataBase2.Str-import System.IO.Unsafe-import Paths_hoogle--import Hoogle.Type.TagStr-import qualified Hoogle.DataBase.All as H-import qualified Hoogle.Query.All as H-import qualified Hoogle.Score.All as H-import qualified Hoogle.Search.All as H-import qualified Hoogle.Type.All as H-import qualified Hoogle.Language.Haskell as H--import Hoogle.Query.All(Query, exactSearch)-import Hoogle.Score.All(Score)---- Turn on the new index/search pieces-new = False-new2 = False---- * Database---- | A Hoogle database, containing a set of functions/items which can be searched. The 'Database' type is used---   for a variety of purposes:------   [Creation] A database is created by merging existing databases with the 'Monoid' instance and 'mappend',---   or by creating a new 'Database' from an input file with 'createDatabase'.------   [Serialization] A database is saved to disk with 'saveDatabase' and loaded from disk with 'loadDatabase'.------   [Searching] A database is searched using 'search'.-newtype Database = Database [(FilePath, H.DataBase)]--toDataBase (Database x) = H.combineDataBase $ map snd x--instance NFData Database where-    rnf (Database a) = rnf a--instance Monoid Database where-    mempty = Database []-    mappend (Database xs) (Database ys) = Database $ xs ++ ys--instance Show Database where-    show = show . toDataBase----- | Save a database to a file.-saveDatabase :: FilePath -> Database -> IO ()-saveDatabase file x@(Database xs) = do-    performGC-    H.saveDataBase file $ toDataBase x-    when new $ do-        performGC-        mergeStr [x <.> "str" | (x,_) <- xs] (file <.> "str")+import Control.DeepSeq (NFData) +import Query+import Input.Item+import General.Util+import General.Store -mergeDatabase :: [FilePath] -> FilePath -> IO ()-mergeDatabase src out = do-    x <- mapM loadDatabase src-    saveDatabase out $ mconcat x+import Action.CmdLine+import Action.Generate+import Action.Search+import Action.Server+import Action.Test  --- | Load a database from a file. If the database was not saved with the same version of Hoogle,---   it will probably throw an error.-loadDatabase :: FilePath -> IO Database-loadDatabase x = do db <- H.loadDataBase x; return $ Database [(x, db)]+-- | Database containing Hoogle search data.+newtype Database = Database StoreRead +-- | Load a database from a file.+withDatabase :: NFData a => FilePath -> (Database -> IO a) -> IO a+withDatabase file act = storeReadFile file $ act . Database +-- | The default location of a database defaultDatabaseLocation :: IO FilePath-defaultDatabaseLocation = getDataDir----- | Create a database from an input definition. Source files for Hoogle databases are usually---   stored in UTF8 format, and should be read using 'hSetEncoding' and 'utf8'.-createDatabase-    :: H.HackageURL-    -> H.Language -- ^ Which format the input definition is in.-    -> [Database] -- ^ A list of databases which contain definitions this input definition relies upon (e.g. types, aliases, instances).-    -> String -- ^ The input definitions, usually with one definition per line, in a format specified by the 'Language'.-    -> FilePath -- ^ Output file-    -> IO [H.ParseError] -- ^ A list of any parse errors present in the input definition that were skipped.-createDatabase url _ dbs src out = do-    let (err,res) = H.parseInputHaskell url src-    let xs = concat [map snd x | Database x <- dbs]-    let db = H.createDataBase xs res-    performGC-    items <- H.saveDataBase out db-    -- don't build .str for .dep files-    when (new && takeExtension out == ".hoo") $ do-        createStr' (newPackage $ takeBaseName out) (map (Pos *** fromOnce) items) (out <.> "str")-    when (new2 && takeExtension out == ".hoo") $ do-        items <- fmap (map snd) $ H.saveDataBase (dropExtension out <.> "idx.hoo") $ H.createDataBaseEntries res-        items <- return $ flip map items $ unsafeFmapOnce $ \e -> e{H.entryLocations = map (first $ const "") $ H.entryLocations e, H.entryName="", H.entryText=mempty, H.entryDocs=mempty}-        H.saveDataBase (dropExtension out <.> "str.hoo") $ H.createDataBaseText items-        H.saveDataBase (dropExtension out <.> "typ.hoo") $ H.createDataBaseType xs res items-        return ()-    return err----- | Show debugging information on some parts of the database. If the second argument---   is 'Nothing' the whole database will be shown. Otherwise, the listed parts will be shown.-showDatabase :: Database -> Maybe [String] -> String-showDatabase x sects = concatMap (`H.showDataBase` toDataBase x) $ fromMaybe [""] sects----- Hoogle.Query---- | Parse a query for a given language, returning either a parse error, or a query.-parseQuery :: H.Language -> String -> Either H.ParseError Query-parseQuery _ = H.parseQuery----- Hoogle.Search---- Invariant: locations will not be empty-data Result = Result-    {locations :: [(URL, [(URL, String)])] -- your location, your parents-    ,self :: TagStr -- ^ Rendered view for the entry, including name/keywords/type as appropriate, colors matching 'renderQuery'-    ,docs :: TagStr -- ^ Documentation for the entry-    }-    deriving (Eq, Show)--toResult :: H.Result -> (Score,Result)-toResult r@(H.Result ent view score) = (score, Result parents self docs)-    where-        self = H.renderResult r+defaultDatabaseLocation = defaultDatabaseLang Haskell -        parents = map (second $ map f) $  H.entryLocations ent-        f = (H.entryURL &&& H.entryName) . fromOnce-        docs = H.renderDocs $ H.entryDocs ent+-- | Search a database, given a query string, produces a list of results.+searchDatabase :: Database -> String -> [Target]+searchDatabase (Database db) query = snd $ search db $ parseQuery query  --- | Perform a search. The results are returned lazily.-search :: Database -> Query -> [(Score,Result)]-search (Database xs@((root,_):_)) (H.Query [name] Nothing scopes Nothing False) | new && all simple scopes =-    unsafePerformIO $ map toResult <$> searchStr' resolve (map fst xs) name-    where resolve pkg pos = runSGetAt pos (takeDirectory root </> pkg <.> "hoo") get-          simple (H.Scope a b _) = a && b == H.Package-search (Database xs) q = map toResult $ H.search (map snd xs) q---- | Given a query and a database optionally give a list of what the user might have meant.-suggestions :: Database -> Query -> Maybe TagStr-suggestions (Database dbs) q = H.suggestQuery (map snd dbs) q---- | Given a query string and a database return a list of the possible completions for the search.-completions :: Database -> String -> [String]-completions x = H.completions (toDataBase x) -- FIXME: Doing a merge on completions? Bad idea.---- | Given a query, set whether it is an exact query.-queryExact :: Maybe H.ItemKind -> Query -> Query-queryExact kind q = q { exactSearch = kind }+-- | Run a command line Hoogle operation.+hoogle :: [String] -> IO ()+hoogle args = do+    args <- getCmdLine args+    case args of+        Search{} -> actionSearch args+        Generate{} -> actionGenerate args+        Server{} -> actionServer args+        Test{} -> actionTest args+        Replay{} -> actionReplay args
− src/Hoogle/DataBase/Aliases.hs 
@@ -1,104 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--module Hoogle.DataBase.Aliases(-    Aliases, createAliases, normAliases-    ) where--import Hoogle.Type.All-import qualified Data.Map as Map-import Hoogle.Store.All-import Data.Generics.Uniplate-import General.Base-import Safe---newtype Aliases = Aliases {fromAliases :: Map.Map String Alias}--instance NFData Aliases where-    rnf (Aliases a) = rnf a--instance Store Aliases where-    put = put . fromAliases-    get = get1 Aliases--instance Show Aliases where-    show (Aliases mp) = unlines [ unwords $ "type" : s : vs ++ ["=", show t]-                                | (s,Alias vs t) <- Map.toList mp]---data Alias = Alias-    {_args :: [String] -- the free variables-    ,rhs :: Type -- the resulting type-    }-    deriving Typeable--instance NFData Alias where-    rnf (Alias a b) = rnf (a,b)--instance Store Alias where-    put (Alias a b) = put2 a b-    get = get2 Alias---createAliases :: [Aliases] -> [Fact] -> Aliases-createAliases deps ti = mergeAliases (a:deps)-    where-        a = Aliases $ transitiveClosure $ Map.fromList-            [ (name, Alias [v | TVar v <- args] rhs)-            |  FactAlias (TypeSig _ lhs) (TypeSig _ rhs) <- ti-            , let (TLit name, args) = fromTApp lhs]----- the first is the most important-instance Monoid Aliases where-    mempty = mergeAliases []-    mappend x y = mergeAliases [x,y]-    mconcat = mergeAliases---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--- i.e. template-haskell has "type Doc = PprM Doc"--- probably the result of unqualifying names-transitiveClosure :: Map.Map String Alias -> Map.Map String Alias-transitiveClosure mp = Map.mapWithKey (\k x -> x{rhs = f [k] $ rhs x}) mp-    where-        f :: [String] -> Type -> Type-        f seen t = case [(name,x) | (name,x) <- followAliases (Aliases mp) t, name `notElem` seen] of-                        [] -> t-                        (name,x):_ -> f (name:seen) x----- perform a 1-step alias following-followAliases :: Aliases -> Type -> [(String,Type)]-followAliases as t =-    [ (s, gen x2)-    | (x, gen) <- contexts t-    , Just (s,x2) <- [followAlias as x]]---followAlias :: Aliases -> Type -> Maybe (String, Type)-followAlias (Aliases mp) (TApp (TLit x) xs)-    | isJust m && length xs == length vs = Just (x, transform f rhs)-    where m@ ~(Just (Alias vs rhs)) = Map.lookup x mp-          rep = zip vs xs-          f (TVar v) = lookupJustDef (TVar v) v rep-          f x = x-followAlias as (TLit x) = followAlias as (TApp (TLit x) [])-followAlias _ _ = Nothing---normAliases :: Aliases -> Type -> ([String], Type)-normAliases as t = first (sort . nub) $ f t-    where-        f t = case followAlias as t2 of-                   Nothing -> (concat ss, t2)-                   Just (s,t2) -> (s : concat ss, t2)-            where-                (cs, gen) = uniplate t-                (ss, css) = unzip $ map f cs-                t2 = gen css
− src/Hoogle/DataBase/All.hs 
@@ -1,81 +0,0 @@-module Hoogle.DataBase.All-    (DataBase, showDataBase-    ,module Hoogle.DataBase.All-    ,module Hoogle.DataBase.Serialise-    ) where--import Prelude()-import General.Base-import Hoogle.Store.All-import Hoogle.DataBase.Type-import Hoogle.Type.All-import Hoogle.Score.All-import Hoogle.DataBase.Serialise---createDataBase :: [DataBase] -> Input -> DataBase-createDataBase deps (facts,xs) = DataBase items-        ns (createTypeSearch as is tys)-        (createSuggest (map suggest deps) facts) as is-    where-        items = createItems xs-        ys = entriesItems items-        ns = createSubstrSearch [(k, y) | y <- ys, let k = entryKey $ fromOnce y, k /= ""]-        as = createAliases (map aliases deps) facts-        is = createInstances (map instances deps) facts-        tys = [(sig, x) | x <- ys, Just sig <- [entryType $ fromOnce x]]---createDataBaseEntries :: Input -> DataBase-createDataBaseEntries (facts,xs) = DataBase (createItems xs) (createSubstrSearch []) (createTypeSearch mempty mempty []) mempty mempty mempty--createDataBaseText :: [Once Entry] -> DataBase-createDataBaseText ys = DataBase mempty ns (createTypeSearch mempty mempty []) mempty mempty mempty-    where ns = createSubstrSearch [(k, y) | y <- ys, let k = entryKey $ fromOnce y, k /= ""]--createDataBaseType :: [DataBase] -> Input -> [Once Entry] -> DataBase-createDataBaseType deps (facts,_) ys = DataBase mempty-        (createSubstrSearch []) (createTypeSearch as is tys)-        (createSuggest (map suggest deps) facts) as is-    where-        as = createAliases (map aliases deps) facts-        is = createInstances (map instances deps) facts-        tys = [(sig, x) | x <- ys, Just sig <- [entryType $ fromOnce x]]---combineDataBase :: [DataBase] -> DataBase-combineDataBase [db] = db-combineDataBase dbs = DataBase items_-        ns (createTypeSearch as is tys)-        ss as is-    where-        items_ = mconcat $ map items dbs-        ys = entriesItems items_-        ns = createSubstrSearch [(entryKey $ fromOnce y, y) | y <- ys]-        ss = mconcat $ map suggest dbs-        as = mconcat $ map aliases dbs-        is = mconcat $ map instances dbs-        tys = [(sig, x) | x <- ys, Just sig <- [entryType $ fromOnce x]]---searchName :: DataBase -> String -> [(Once Entry,EntryView,Score)]-searchName db = searchSubstrSearch (nameSearch db)--searchExactName :: ItemKind -> DataBase -> String -> [(Once Entry,EntryView,Score)]-searchExactName kind db = filter' . searchExactSearch (nameSearch db)-  where filter' = if kind == UnclassifiedItem-                  then id-                  else filter (\(ent,_,_) -> kind == entryKind (fromOnce ent))---searchType :: DataBase -> TypeSig -> [(Once Entry,[EntryView],Score)]--- although aliases and instances are given, they are usually not used-searchType db = searchTypeSearch (aliases db) (instances db) (typeSearch db)---suggestion :: [DataBase] -> TypeSig -> Maybe (Either String TypeSig)-suggestion db = askSuggest (map suggest db)---completions :: DataBase -> String -> [String]-completions db = completionsSubstrSearch (nameSearch db)
− src/Hoogle/DataBase/Instances.hs 
@@ -1,61 +0,0 @@--module Hoogle.DataBase.Instances(-    Instances, createInstances,-    normInstances, hasInstance-    ) where--import General.Base-import Hoogle.Type.All-import Hoogle.Store.All-import qualified Data.Map as Map----- Map type [classes]-newtype Instances = Instances {fromInstances :: Map.Map String [String]}--instance NFData Instances where-    rnf (Instances a) = rnf a--instance Show Instances where-    show (Instances mp) = unlines $ map f $ Map.toList mp-        where f (v,cs) = "instance " ++ v ++ " <= " ++ unwords cs---instance Store Instances where-    put = put1 . fromInstances-    get = get1 Instances---createInstances :: [Instances] -> [Fact] -> Instances-createInstances deps xs = mergeInstances (i:deps)-    where-        i = Instances $ foldl f Map.empty ys-        ys = [(v, c) | FactInstance (TypeSig [] (TApp (TLit c) vs)) <- xs, TLit v <- vs]-        f mp (v,c) = Map.insertWith (++) v [c] mp---instance Monoid Instances where-    mempty = mergeInstances []-    mappend x y = mergeInstances [x,y]-    mconcat = mergeInstances--mergeInstances :: [Instances] -> Instances-mergeInstances = Instances . Map.unionsWith (\x y -> nub $ x ++ y) . map fromInstances------- Convert:---    MPTC a b |-> MPTC a, MPTC b---    C (M a) |-> C a--- Do not load Instances ever-normInstances :: Instances -> TypeSig -> TypeSimp-normInstances _ (TypeSig a b) = TypeSimp con b-    where-        con = sort $ nub [(c,v) | TApp (TLit c) xs <- a, x <- xs, v <- variables x, v `elem` vs]-        vs = variables b----- hasInstance _ C M, does C M exist-hasInstance :: Instances -> String -> String -> Bool-hasInstance (Instances mp) c m = c `elem` Map.findWithDefault [] m mp
− src/Hoogle/DataBase/Items.hs 
@@ -1,62 +0,0 @@-{-# LANGUAGE RecordWildCards, PatternGuards #-}--module Hoogle.DataBase.Items(Items, createItems, entriesItems) where--import General.Base-import General.Web-import Hoogle.Type.All-import qualified Data.Map as Map-import Hoogle.Store.All---- Invariant: items are by order of EntryScore-newtype Items = Items {fromItems :: Defer [Once Entry]}--instance NFData Items where-    rnf (Items a) = rnf a--entriesItems :: Items -> [Once Entry]-entriesItems = fromDefer . fromItems---instance Store Items where-    put (Items a) = put1 a-    get = get1 Items---instance Show Items where-    show (Items x) = "== Entries ==\n\n" ++ show x---instance Monoid Items where-    mempty = mergeItems []-    mappend x y = mergeItems [x,y]-    mconcat = mergeItems---createItems :: [TextItem] -> Items-createItems xs = mergeItems [Items $ Defer $ fs Nothing Nothing xs]-    where-        fs pkg mod [] = []-        fs pkg mod (x:xs) = r : fs pkg2 mod2 xs-            where r = f pkg2 mod2 x-                  pkg2 = if itemLevel x == 0 then Just r else pkg-                  mod2 = if itemLevel x == 1 then Just r else mod--        f pkg mod TextItem{..} = once $ Entry [(url, catMaybes [pkg,mod])] itemKind itemLevel itemName itemDisp-            (readDocsHTML itemDocs) itemPriority itemKey itemType-            where url | Just pkg <- pkg, itemLevel == 1 || (itemLevel > 1 && isNothing mod) = entryURL (fromOnce pkg) `combineURL` itemURL-                      | Just mod <- mod, itemLevel > 1 = entryURL (fromOnce mod) `combineURL` itemURL-                      | otherwise = itemURL----- | Given a set of items, which may or may not individually satisfy the entryScore invariant,---   make it so they _do_ satisfy the invariant.---   Also merge any pair of items which are similar enough.------   If something which is a parent gets merged, then it will still point into the database,---   but it won't be very useful.-mergeItems :: [Items] -> Items-mergeItems = Items . Defer . sortOn (entryScore . fromOnce) . Map.elems . foldl' add Map.empty . concatMap entriesItems-    where-        add mp x = Map.insertWith (\x1 x2 -> once $ entryJoin (fromOnce x1) (fromOnce x2))-                                  (entryUnique $ fromOnce x) x mp
− src/Hoogle/DataBase/Serialise.hs 
@@ -1,63 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--module Hoogle.DataBase.Serialise(-    saveDataBase, loadDataBase-    ) where--import Hoogle.Store.All-import General.Base-import General.System--import Hoogle.DataBase.Type-import Hoogle.Type.All-import Control.Monad.IO.Class-import Paths_hoogle(version)-import Data.Version-import Data.IORef---hooVersion = take 4 $ map fromIntegral (versionBranch version) ++ [0..]-hooString = "HOOG"--data Identity = Identity deriving (Show, Typeable)--instance Store Identity where-    put Identity = mapM_ put hooString >> mapM_ putByte hooVersion-    get = do-        cs <- replicateM 4 get-        vr <- replicateM 4 getByte-        when (cs /= hooString) $-            error $ "Not a hoogle database"--        let showVer = intercalate "." . map show-        when (vr /= hooVersion) $-            error $ "Wrong hoogle database version: found " ++ showVer vr ++ ", " ++-                    "expected " ++ showVer hooVersion-        return Identity---saveDataBase :: FilePath -> DataBase -> IO [(Word32, Once Entry)]-saveDataBase file db = do-    ref <- newIORef []-    runSPut file $ do-        put (Identity, db)-        runAfter $ do-            res <- forM (entriesItems $ items db) $ \e -> do-                pos <- findOnce e-                case pos of-                    Nothing -> do-                        liftIO $ print $ "Could not find position of " ++ show e-                        return Nothing-                    Just pos -> return $ Just (pos, e)-            liftIO $ writeIORef ref $ catMaybes res-    readIORef ref---loadDataBase :: FilePath -> IO DataBase-loadDataBase file = do-    sz <- withFile file ReadMode hFileSize-    when (sz < 12) $-        error $ "Not a hoogle database: " ++ file--    (Identity,db) <- runSGet file get-    return db
− src/Hoogle/DataBase/SubstrSearch.hs 
@@ -1,200 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--module Hoogle.DataBase.SubstrSearch-    (SubstrSearch, createSubstrSearch-    ,searchSubstrSearch-    ,searchExactSearch-    ,completionsSubstrSearch-    ) where--import Hoogle.Store.All-import qualified Data.Set as Set-import qualified Data.ByteString as BS-import qualified Data.ByteString.Unsafe as BS-import qualified Data.ByteString.Char8 as BSC-import qualified Data.Char as C-import General.Base-import Data.Array-import Hoogle.Type.All-import Hoogle.Score.All--{--Format 2:---- build a Huffman table-huffman :: Eq a => [a] -> Huffman a---- encode a value using the table--- return the first 32 bits of the encoding, and a mask (will be all 1's if more than 32 bits)-encode :: Huffman a -> [a] -> (Word32, Word32)----- We have 4 buckets, one per priority level - Prelude first, then base, then platform, then anything-data Substr a = Substr [Bucket a]---- Each bucket contains the encoding of each entry (a pointer to it) along--- with the Word32 prefix of each string--- the 31'st bit is 1 if the string comes from the start of a string--- and the 32'nd bit is 1 if the string contains upper case letters--- within each entry, the tree is used to find shifts--- items are sorted by prefixes-data Bucket a = Bucket {answers :: [a], prefixes :: [Word32], tree :: Tree}---- at each tree point the range is the start/end index where you may find things with that prefix--- if the Maybe is Just then all the points in that range are shifted by one bit-data Tree = Tree {range :: (Int, Int), rest :: Maybe (Tree, Tree)}--}------ idea for speed improvement--- store as one long bytestring with \0 between the words, then do findSubstrings to find the indexes--- store the lengths in a separate bytestring then use index to step through them, retrieving the data as Word8 via foldl--- store the links in another bytestring with the lengths, but only unpack them when they are needed--- can even make length==0 code for it's the same string as before, to compress it and reduce searching--- was previously ~ 0.047 seconds--{--Description:--Data is stored flattened. For default we expect ~200Kb of disk usage.--}---- keys are sorted after being made lower case-data SubstrSearch a = SubstrSearch-    {text :: BString  -- all the bytestrings, in preference order-    ,lens :: BString  -- a list of lengths-    ,inds :: Array Int a  -- the results-    }-    deriving Typeable--instance NFData a => NFData (SubstrSearch a) where-    rnf (SubstrSearch a b c) = rnf (a `seq` (),b `seq` (),c)---- | Create a substring search index. Values are returned in order where possible.-createSubstrSearch :: [(String,a)] -> SubstrSearch a-createSubstrSearch xs = SubstrSearch-    (fromString $ concat ts2)-    (BS.pack $ map fromIntegral ls2)-    (listArray (0,length is-1) is)-    where-        (ts,is) = unzip xs-        (ts2,ls2) = f "" ts--        f x (y:ys) = first (y:) $ second (length y:) $ f y ys-        f x [] = ([],[])---data S a = S-    {sCount :: !Int -- which one are we on-    ,sFocus :: !BS.ByteString -- where we are in the string-    ,sPrefix :: ![(a,EntryView,Score)] -- the prefixes-    ,sInfix :: ![(a,EntryView,Score)] -- the infixes-    }---toChar :: Word8 -> Char-toChar = C.chr . fromIntegral---- | Unsafe version of 'fromChar'-ascii :: Char -> Word8-ascii = fromIntegral . C.ord-{-# INLINE ascii #-}--searchSubstrSearch :: SubstrSearch a -> String -> [(a, EntryView, Score)]-searchSubstrSearch x y = reverse (sPrefix sN) ++ reverse (sInfix sN)-    where-        view = FocusOn y-        match = bsMatch (BSC.pack y)-        sN = BS.foldl f s0 $ lens x-        s0 = S 0 (text x) [] []--        f s ii = addCount $ moveFocus i $ maybe id addMatch t s-            where t = match i $ BS.map (ascii . toChar)-                      $ BS.unsafeTake i $ sFocus s-                  i = fromIntegral ii--        addCount s = s{sCount=sCount s+1}-        moveFocus i s = s{sFocus=BS.unsafeDrop i $ sFocus s}-        addMatch MatchSubstr s = s{sInfix =(inds x ! sCount s,view,textScore MatchSubstr):sInfix s}-        addMatch t s = s{sPrefix=(inds x ! sCount s,view,textScore t):sPrefix s}--searchExactSearch :: SubstrSearch a -> String -> [(a, EntryView, Score)]-searchExactSearch x y = reverse (sPrefix sN)-    where-        view = FocusOn y-        match = bsMatch (BSC.pack y)-        sN = BS.foldl f s0 $ lens x-        s0 = S 0 (text x) [] []--        f s ii = addCount $ moveFocus i $ maybe id addMatch t s-            where t = match i $ BS.unsafeTake i $ sFocus s-                  i = fromIntegral ii--        addCount s = s{sCount=sCount s+1}-        moveFocus i s = s{sFocus=BS.unsafeDrop i $ sFocus s}-        addMatch MatchExact s = s{sPrefix=(inds x ! sCount s,view,textScore MatchExact):sPrefix s}-        addMatch _ s = s---data S2 = S2-    {_s2Focus :: !BS.ByteString -- where we are in the string-    ,s2Result :: Set.Set BS.ByteString-    }--completionsSubstrSearch :: SubstrSearch a -> String -> [String]-completionsSubstrSearch x y = map (\x -> y ++ drop ny (BSC.unpack x)) $ take 10 $ Set.toAscList $-                              s2Result $ BS.foldl f (S2 (text x) Set.empty) $ lens x-    where-        ny = length y-        ly = fromString $ map toLower y-        f (S2 foc res) ii = S2 (BS.unsafeDrop i foc) (if ly `BS.isPrefixOf` x then Set.insert x res else res)-            where x = BS.map (ascii . toLower . toChar) $ BS.unsafeTake i foc-                  i = fromIntegral ii---instance Show a => Show (SubstrSearch a) where-    show x = "SubstrSearch"--instance (Typeable a, Store a) => Store (SubstrSearch a) where-    put (SubstrSearch a b c) = putDefer $ put3 a b c-    get = getDefer $ get3 SubstrSearch----- if first word is empty, always return Exact/Prefix--- if first word is a single letter, do elemIndex--- if first word is multiple, do isPrefixOf's but only up until n from the end--- partially apply on the first word-bsMatch :: BS.ByteString -> Int -> BS.ByteString -> Maybe TextMatch-bsMatch x-    | nx == 0 = \ny _ -> Just $ if ny == 0 then MatchExact else MatchPrefix-    | nx == 1 = \ny y ->-                maybe (bsCharMatch MatchExactCI MatchPrefixCI False-                           (BS.head (bsLower x)) ny (bsLower y))-                    Just (bsCharMatch MatchExact MatchPrefix True-                              (BS.head x) ny y)-    | otherwise = \ny y ->-        maybe (bsWordMatch MatchExactCI MatchPrefixCI False-                   (bsLower x) ny (bsLower y))-            Just (bsWordMatch MatchExact MatchPrefix True x ny y)- where-    nx = BS.length x--    bsLower = BS.map (ascii . toLower . toChar)--    bsCharMatch exactKind prefixKind ignoreSubstr c ny y =-        case BS.elemIndex c y of-            Nothing -> Nothing-            Just 0 -> Just $ if ny == 1-                             then exactKind-                             else prefixKind-            Just _-                | ignoreSubstr -> Nothing-                | otherwise    -> Just MatchSubstr--    bsWordMatch exactKind prefixKind ignoreSubstr x' ny y =-        if BS.isPrefixOf x' y-        then Just (if nx == ny then exactKind else prefixKind)-        else if not ignoreSubstr && BS.isInfixOf x' y-             then Just MatchSubstr-             else Nothing
− src/Hoogle/DataBase/Suggest.hs 
@@ -1,155 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--module Hoogle.DataBase.Suggest(Suggest, createSuggest, askSuggest) where--import General.Base-import General.Util-import Hoogle.Store.All-import qualified Data.Map as Map-import Hoogle.Type.All-import Data.Generics.Uniplate---newtype Suggest = Suggest {fromSuggest :: Map.Map String SuggestItem}---- if something is both a data and a ctor, no need to mention the ctor-data SuggestItem = SuggestItem-    {suggestCtor :: Maybe String -- constructor (and who the type is)-    ,suggestData :: [(String,Int)] -- data type, name (case correct), and possible kinds-    ,suggestClass :: [(String,Int)] -- class, name (case correct), kinds-    }-    deriving Typeable---instance NFData Suggest where-    rnf (Suggest a) = rnf a--instance NFData SuggestItem where-    rnf (SuggestItem a b c) = rnf (a,b,c)--instance Show Suggest where-    show (Suggest x) = show x--instance Show SuggestItem where-    show (SuggestItem a b c) = intercalate ", " $-        ["ctor " ++ x | Just x <- [a]] ++ f "data" b ++ f "class" c-        where-            f msg xs = [msg ++ " " ++ a ++ " " ++ show b | (a,b) <- xs]---instance Store Suggest where-    put (Suggest x) = put x-    get = get1 Suggest--instance Store SuggestItem where-    put (SuggestItem a b c) = put3 a b c-    get = get3 SuggestItem--instance Monoid Suggest where-    mempty = mergeSuggest []-    mappend x y = mergeSuggest [x,y]-    mconcat = mergeSuggest---- note: do not look inside class's for data type information---       as they may have higher-kinds and get it wrong-createSuggest :: [Suggest] -> [Fact] -> Suggest-createSuggest deps xs = mergeSuggest (s:deps)-    where-        s = Suggest 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)] [])-        sClass c n = (c, SuggestItem Nothing [] [(c,n)])--        getTextItem :: Fact -> [(String,SuggestItem)]-        getTextItem (FactDataKind a b) = [sData a b]-        getTextItem (FactClassKind a b) = [sClass a b]-        getTextItem (FactCtorType a b) = [(a, SuggestItem (Just b) [] [])]-        getTextItem _ = []---mergeSuggest :: [Suggest] -> Suggest-mergeSuggest = Suggest . Map.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)-        (f b1 b2) (f c1 c2)-    where-        f x y = map (second maximum) $ sortGroupFsts $ x ++ y---askSuggest :: [Suggest] -> TypeSig -> Maybe (Either String TypeSig)-askSuggest sug q@(TypeSig con typ)-        | q2 /= q = Just (Right q2)-        | not $ null datas = unknown "type" datas-        | not $ null classes = unknown "class" classes-        | otherwise = Nothing-    where-        tries = map fromSuggest sug-        get x = case mapMaybe (Map.lookup $ map toLower x) tries of-                    [] -> 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-                   , not $ isTLitTuple x, bad False x]-        unknown typ (x:_) = Just $ Left $ "Warning: Unknown " ++ typ ++ " " ++ x--        bad cls name = case get name of-            Nothing -> True-            Just i | cls -> null $ suggestClass i-                   | otherwise -> null (suggestData i) && isNothing (suggestCtor i)----- 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)---improve :: (String -> Maybe SuggestItem) -> Bool -> Type -> Type-improve get cls typ-        | not cls = f $ transform (improveName nameTyp) typ-        | otherwise = 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 
@@ -1,53 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--module Hoogle.DataBase.Type(module Hoogle.DataBase.Type, module X) where--import Hoogle.DataBase.Items           as X-import Hoogle.DataBase.Suggest         as X-import Hoogle.DataBase.Aliases         as X-import Hoogle.DataBase.Instances       as X-import Hoogle.DataBase.SubstrSearch    as X-import Hoogle.DataBase.TypeSearch.All  as X-import Hoogle.Store.All-import Hoogle.Type.All-import General.Base----- suggest, aliases and instances are used for linking with packages--- that depend on this database-data DataBase = DataBase-    {items :: Items-    ,nameSearch :: SubstrSearch (Once Entry)-    ,typeSearch :: TypeSearch-    ,suggest :: Suggest-    ,aliases :: Aliases-    ,instances :: Instances-    }-    deriving Typeable--instance NFData DataBase where-    rnf (DataBase a b c d e f) = rnf (a,b,c,d,e,f)--instance Store DataBase where-    put (DataBase a b c d e f) = put6 a b c d e f-    get = get6 DataBase---instance Show DataBase where-    show = concatMap snd . showDataBaseParts---showDataBaseParts :: DataBase -> [(String,String)]-showDataBaseParts (DataBase a b c d e f) =-    let name * val = (name, "= " ++ name ++ " =\n\n" ++ show val ++ "\n") in-    ["Items" * a,"NameSearch" * b, "TypeSearch" * c-    ,"Suggest" * d, "Aliases" * e, "Instances" * f]---showDataBase :: String -> DataBase -> String-showDataBase "" d = show d-showDataBase x d | null r = "Error: Unknown database part, " ++ x-                 | length r > 1 = "Error: Ambiguous database part, " ++ x-                 | otherwise = head r-    where r = [b | (a,b) <- showDataBaseParts d, lower x `isPrefixOf` lower a]-
− src/Hoogle/DataBase/TypeSearch/All.hs 
@@ -1,45 +0,0 @@---- TODO: Aliases and Instances from imported packages should be--- used when searching.--module Hoogle.DataBase.TypeSearch.All(-    createTypeSearch, TypeSearch,-    searchTypeSearch, TypeScore-    ) where--import Hoogle.DataBase.TypeSearch.Graphs-import Hoogle.DataBase.TypeSearch.TypeScore-import Hoogle.DataBase.Instances-import Hoogle.DataBase.Aliases-import Hoogle.Store.All-import Hoogle.Type.All-import Hoogle.Score.All-import General.Base---newtype TypeSearch = TypeSearch Graphs--instance NFData TypeSearch where-    rnf (TypeSearch a) = rnf a--instance Show TypeSearch where-    show (TypeSearch x) = show x--instance Store TypeSearch where-    put (TypeSearch x) = put x-    get = get1 TypeSearch--------------------------------------------------------------------------- CREATION--createTypeSearch :: Aliases -> Instances -> [(TypeSig, Once Entry)] -> TypeSearch-createTypeSearch aliases instances xs = TypeSearch $ newGraphs aliases instances xs--------------------------------------------------------------------------- SEARCHING--searchTypeSearch :: Aliases -> Instances -> TypeSearch -> TypeSig -> [(Once Entry,[EntryView],Score)]-searchTypeSearch as is (TypeSearch g) t =-    [(a, b, typeScore $ costsTypeScore c) | (a,b,c) <- graphsSearch as is g t]
− src/Hoogle/DataBase/TypeSearch/Binding.hs 
@@ -1,123 +0,0 @@-{-|-    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(-    Binding, newBinding, newBindingUnbox, newBindingRebox,-    addBinding, costBinding, costsBinding, mergeBindings, bindings-    ) where--import Hoogle.Type.All-import Hoogle.Score.All-import Data.Function-import General.Base-import qualified Data.Map as Map-import qualified Data.Set as Set---type Var = String-type Lit = String---type Bind = Map.Map Var (Maybe Lit, Set.Set Var)--data Binding = Binding !Int [Box] Bind Bind--data Box = Unbox | Rebox-           deriving (Show,Eq)---instance Show Binding where-    show b@(Binding _ box _ _) = unwords $ map (map toLower . show) box ++ map f (bindings b)-        where f (a,b) = show a ++ "=" ++ show b---instance Eq Binding where-    (==) = (==) `on` costBinding--instance Ord Binding where-    compare = comparing costBinding---costBinding :: Binding -> Int-costBinding (Binding x _ _ _) = x---newBinding, newBindingUnbox, newBindingRebox :: Binding-newBinding      = Binding 0                []      Map.empty Map.empty-newBindingUnbox = Binding (cost CostUnbox) [Unbox] Map.empty Map.empty-newBindingRebox = Binding (cost CostRebox) [Rebox] Map.empty Map.empty----costIf b v = if b then cost v else 0---addBinding :: (Type, Type) -> Binding -> Maybe Binding-addBinding (TVar a, TVar b) (Binding c box x y) = Just $ Binding c2 box x2 y2-    where (x2,cx) = addVar a b x-          (y2,cy) = addVar b a y-          c2 = c + costIf cx CostDupVarQuery + costIf cy CostDupVarResult--addBinding (TVar a, TLit b) (Binding c box x y) = do-    (x2,cx) <- addLit a b x-    return $ Binding (c + costIf cx CostRestrict) box x2 y-addBinding (TLit a, TVar b) (Binding c box x y) = do-    (y2,cy) <- addLit b a y-    return $ Binding (c + costIf cy CostUnrestrict) box x y2--addBinding (TLit a, TLit b) bind = if a == b then Just bind else Nothing---addVar :: Var -> Var -> Bind -> (Bind, Bool)-addVar a b mp = case Map.lookup a mp of-    Nothing -> (Map.insert a (Nothing, Set.singleton b) mp, False)-    Just (l, vs) | b `Set.member` vs -> (mp, False)-                 | otherwise -> (Map.insert a (l, Set.insert b vs) mp, True)---addLit :: Var -> Lit -> Bind -> Maybe (Bind, Bool)-addLit a b mp | l == Just b = Just (mp, False)-              | isJust l = Nothing-              | otherwise = Just (Map.insert a (Just b, vs) mp, True)-    where (l, vs) = Map.findWithDefault (Nothing, Set.empty) a mp----mergeBindings :: [Binding] -> Maybe Binding-mergeBindings bs = do-    let (box,ls,rs) = unzip3 [(b,l,r) | Binding _ b l r <- bs]-        (bl,br) = (Map.unionsWith f ls, Map.unionsWith f rs)-        res i = Binding i (concat box) bl br-    s <- costsBindingLocal (res 0)-    return $ res (sum $ map cost s)-    where-        f (l1,vs1) (l2,vs2)-            | l1 /= l2 && isJust l1 && isJust l2 = (Just "", vs1)-            | otherwise = (l1 `mplus` l2, Set.union vs1 vs2)---costsBindingLocal :: Binding -> Maybe [TypeCost]-costsBindingLocal (Binding _ box l r) = do-    let cb = [if b == Unbox then CostUnbox else CostRebox | b <- box]-    cl <- f CostDupVarQuery  CostRestrict   l-    cr <- f CostDupVarResult CostUnrestrict r-    return $ cb++cl++cr-    where-        f var restrict = concatMapM g . Map.elems-            where-                g (Just "", _) = Nothing-                g (l, vs) = Just $ [restrict|isJust l] ++ replicate (max 0 $ Set.size vs - 1) var---costsBinding :: Binding -> [TypeCost]-costsBinding = fromJust . costsBindingLocal---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)] ++-    [(TLit l, TVar v) | (v,(Just l,_)) <- Map.toList b]
− src/Hoogle/DataBase/TypeSearch/EntryInfo.hs 
@@ -1,32 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--module Hoogle.DataBase.TypeSearch.EntryInfo where--import Hoogle.Store.All-import Hoogle.Type.All-import General.Base----- the information about an entry, including the arity-data EntryInfo = EntryInfo-    {entryInfoKey :: Int -- allow cheap equality-    ,entryInfoEntries :: [Once Entry]-    ,entryInfoArity :: Int-    ,entryInfoContext :: TypeContext-    ,entryInfoAlias :: [String]-    } deriving (Show,Typeable)--instance NFData EntryInfo where-    rnf (EntryInfo a b c d e) = rnf (a,b,c,d,e)--instance Ord EntryInfo where-    compare (EntryInfo _ [] x1 x2 x3) (EntryInfo _ [] y1 y2 y3) = compare (x1,x2,x3) (y1,y2,y3)-    compare _ _ = error "Ord EntryInfo, can't compare EntryInfo's with items in them"--instance Eq EntryInfo where-    EntryInfo _ [] x1 x2 x3 == EntryInfo _ [] y1 y2 y3 = (x1,x2,x3) == (y1,y2,y3)-    _ == _ = error "Eq EntryInfo, can't compare EntryInfo's with items in them"--instance Store EntryInfo where-    put (EntryInfo a b c d e) = put5 a b c d e-    get = get5 EntryInfo
− src/Hoogle/DataBase/TypeSearch/Graph.hs 
@@ -1,103 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-|-    Search for a type signature and context through a graph.--    Return results in best-first order, taking account of which-    nodes and edges have already been paid for.--}--module Hoogle.DataBase.TypeSearch.Graph(-    Graph, newGraph,-    graphSearch-    ) where--import Hoogle.DataBase.TypeSearch.Binding-import Hoogle.DataBase.TypeSearch.Result-import Hoogle.Type.All-import Data.Generics.Uniplate-import Hoogle.Store.All-import qualified Data.Map as Map-import General.Base-import General.Util----newtype Graph = Graph (Map.Map Type [Node])---- the Type's are stored in reverse, to make box/unbox computations quicker-data Node = Node [Type] [(Once EntryInfo,ArgPos)]-            deriving Typeable---instance NFData Graph where-    rnf (Graph a) = rnf a--instance NFData Node where-    rnf (Node a b) = rnf (a,b)--instance Show Graph where-    show (Graph mp) = unlines $ concatMap f $ Map.toList mp-        where f (t,ns) = show (transform g t) : map (("  "++) . show) ns-              g x = if x == TVar "" then TVar "_" else x--instance Show Node where-    show (Node t xs) = unwords $ map show t ++ "=" : ["?." ++ show b | (a,b) <- xs]---instance Store Graph where-    put (Graph a) = put1 a-    get = get1 Graph--instance Store Node where-    put (Node a b) = put2 a b-    get = get2 Node--------------------------------------------------------------------------- GRAPH CONSTRUCTION---typeStructure :: Type -> Type-typeStructure = transform f-    where f x = if isTLit x || isTVar x then TVar "" else x--typeUnstructure :: Type -> [Type]-typeUnstructure = reverse . filter (\x -> isTLit x || isTVar x) . universe---newGraph :: [(Once EntryInfo, ArgPos, Type)] -> Graph-newGraph = Graph . Map.map newNode . foldl' f Map.empty -    where f mp x = Map.insertWith (++) (typeStructure $ thd3 x) [x] mp---newNode :: [(Once EntryInfo, ArgPos, Type)] -> [Node]-newNode = map (uncurry Node) . sortGroupFsts . map (\(a,b,c) -> (typeUnstructure c,(a,b)))----------------------------------------------------------------------------- GRAPH SEARCHING---- must search for each (node,bindings) pair, rather than just nodes--graphSearch :: Graph -> Type -> [ResultArg]-graphSearch (Graph mp) t = [ResultArg e p b | (b,ep) <- sortFst xs, (e,p) <- ep]-    where-        xs = f newBinding s ++ f newBindingRebox (TApp (TVar "") [s]) ++-             concat [f newBindingUnbox x | TApp (TVar "") [x] <- [s]]-        u = typeUnstructure t-        s = typeStructure t--        f bind x = mapMaybe (graphCheck bind u) $ Map.findWithDefault [] x mp---graphCheck :: Binding -> [Type] -> Node -> Maybe (Binding, [(Once EntryInfo,ArgPos)])-graphCheck b xs (Node ys res) = do-    b <- f b (zip xs ys)-    return (b, res)-    where-        f b [] = Just b-        f b (x:xs) = do-            b <- addBinding x b-            f b xs
− src/Hoogle/DataBase/TypeSearch/Graphs.hs 
@@ -1,134 +0,0 @@--module Hoogle.DataBase.TypeSearch.Graphs where--import Hoogle.DataBase.TypeSearch.Graph-import Hoogle.DataBase.TypeSearch.Binding-import Hoogle.DataBase.TypeSearch.Result-import Hoogle.DataBase.Instances-import Hoogle.DataBase.Aliases-import Hoogle.DataBase.TypeSearch.TypeScore-import Hoogle.Type.All hiding (Result)--import Hoogle.Store.All-import qualified Data.IntMap as IntMap-import qualified General.Heap as Heap-import General.Base-import General.Util-import Control.Monad.Trans.State----- for resGraph, the associated ArgPos is the arity of the function--data Graphs = Graphs-    {argGraph :: Graph -- the arguments-    ,resGraph :: Graph -- the results-    }--instance NFData Graphs where-    rnf (Graphs a b) = rnf (a,b)--instance Show Graphs where-    show (Graphs a b) = "== Arguments ==\n\n" ++ show a ++-                        "\n== Results ==\n\n" ++ show b--instance Store Graphs where-    put (Graphs a b) = put2 a b-    get = get2 Graphs--------------------------------------------------------------------------- GRAPHS CONSTRUCTION--newGraphs :: Aliases -> Instances -> [(TypeSig, Once Entry)] -> Graphs-newGraphs as is xs = Graphs argGraph resGraph-    where-        entries = [ (t2, e2{entryInfoKey=i, entryInfoEntries=map snd ys})-                  | (i, ys@(((t2,e2),_):_)) <- zip [0..] $ sortGroupFst $ map (\(t,e) -> (normType as is t, e)) xs]--        argGraph = newGraph (concat args)-        resGraph = newGraph res--        (args,res) = unzip-            [ initLast $ zipWith (\i t -> (lnk, i, t)) [0..] $ fromTFun t-            | (t, e) <- entries, let lnk = once e]---normType :: Aliases -> Instances -> TypeSig -> (Type, EntryInfo)-normType as is t = (t3, EntryInfo 0 [] (length (fromTFun t3) - 1) c2 a)-    where TypeSimp c2 t2 = normInstances is t-          (a,t3) = normAliases as t2-------------------------------------------------------------------------- GRAPHS SEARCHING----- sorted by TypeScore-graphsSearch :: Aliases -> Instances -> Graphs -> TypeSig -> [ResultReal]-graphsSearch as is gs t = resultsCombine is query ans-    where-        ans = mergesBy (comparing $ resultArgBind . snd) $ -              f Nothing (resGraph gs) res :-              zipWith (\i -> f (Just i) (argGraph gs)) [0..] args--        f a g = map ((,) a) . graphSearch g-        (args,res) = initLast $ fromTFun ts-        (ts,query) = normType as is t---data S = S-    {infos :: IntMap.IntMap (Maybe ResultAll) -- Int = Once EntryInfo-    ,pending :: Heap.Heap Int Result-    ,todo :: [(Maybe ArgPos, ResultArg)]-    ,instances :: Instances-    ,query :: EntryInfo-    }---resultsCombine :: Instances -> EntryInfo -> [(Maybe ArgPos, ResultArg)] -> [ResultReal]-resultsCombine is query xs = flattenResults $ evalState delResult s0-    where s0 = S IntMap.empty Heap.empty xs is query----- Heap -> answer-delResult :: State S [Result]-delResult = do-    pending <- gets pending-    todo <- gets todo-    case todo of-        [] -> concatMapM f $ Heap.elems pending-        t:odo -> do-            let (res,hp) = Heap.popWhile (costBinding $ resultArgBind $ snd t) pending-            modify $ \s -> s{todo=odo, pending=hp}-            ans1 <- concatMapM f res-            uncurry addResult t-            ans2 <- delResult-            return $ ans1 ++ ans2-    where-        f r = do-            infos <- gets infos-            (Just res,infos) <- return $ IntMap.updateLookupWithKey-                (\_ _ -> Just Nothing) (entryInfoKey $ fromOnce $ fst3 r) infos-            if isNothing res then return [] else do-                modify $ \s -> s{infos=infos}-                return [r]----- todo -> heap/info-addResult :: Maybe ArgPos -> ResultArg -> State S ()-addResult arg val = do-    let entId = entryInfoKey $ fromOnce $ resultArgEntry val-    infs <- gets infos-    is <- gets instances-    query <- gets query-    let def = newResultAll query (resultArgEntry val)-    case IntMap.lookup entId infs of-        Just Nothing -> return ()-        Nothing | isNothing def -> modify $ \s -> s{infos = IntMap.insert entId Nothing $ infos s}-        x -> do-            let inf = fromJust $ fromMaybe def x-            (inf,res) <- return $ addResultAll is query (arg,val) inf-            res <- return $ map (costTypeScore . thd3 &&& id) res-            modify $ \s -> s-                {infos = IntMap.insert entId (Just inf) $ infos s-                ,pending = Heap.insertList res (pending s)-                }
− src/Hoogle/DataBase/TypeSearch/Result.hs 
@@ -1,89 +0,0 @@--module Hoogle.DataBase.TypeSearch.Result(-    module Hoogle.DataBase.TypeSearch.Result,-    module Hoogle.DataBase.TypeSearch.EntryInfo-    ) where--import Hoogle.DataBase.TypeSearch.TypeScore-import Hoogle.DataBase.TypeSearch.Binding-import Hoogle.DataBase.TypeSearch.EntryInfo-import Hoogle.DataBase.Instances-import Hoogle.Type.All hiding (Result)-import General.Base-import Hoogle.Store.All-import qualified Data.IntSet as IntSet---type ArgPos = Int----- the return from searching a graph, nearly-type Result = (Once EntryInfo,[EntryView],TypeScore)--type ResultReal = (Once Entry, [EntryView], TypeScore)---flattenResults :: [Result] -> [(Once Entry, [EntryView], TypeScore)]-flattenResults xs = [(a,b,c) | (as,b,c) <- xs, a <- entryInfoEntries $ fromOnce as]----- the result information from a whole type (many ResultArg)--- number of lacking args, entry data, info (result:args)-data ResultAll = ResultAll Int (Once EntryInfo) [[ResultArg]]-                 deriving Show----- the result information from one single type graph (argument/result)--- this result points at entry.id, argument, with such a score-data ResultArg = ResultArg-    {resultArgEntry :: Once EntryInfo-    ,resultArgPos :: ArgPos-    ,resultArgBind :: Binding-    } deriving Show---newResultAll :: EntryInfo -> Once EntryInfo -> Maybe ResultAll-newResultAll query e-    | bad < 0 || bad > 2 = Nothing-    | otherwise = Just $ ResultAll bad e $ replicate (arityResult + 1) []-    where-        arityQuery = entryInfoArity query-        arityResult = entryInfoArity $ fromOnce e-        bad = arityResult - arityQuery---addResultAll :: Instances -> EntryInfo -> (Maybe ArgPos, ResultArg) -> ResultAll -> (ResultAll, [Result])-addResultAll is query (pos,res) (ResultAll i e info) =-        (ResultAll i e info2-        ,mapMaybe (\(r:rs) -> newGraphsResults is query e rs r) path)-    where-        ind = maybe 0 (+1) pos-        info2 = zipWith (\i x -> [res|i==ind] ++ x) [0..] info--        -- path returns a path through the ResultArg's-        -- must skip badarg items-        -- must take one element from 0-        -- must use res from ind-        path :: [[ResultArg]]-        path = f i set $ zip [0..] info-            where set = if ind == 0 then IntSet.empty else IntSet.singleton (resultArgPos res)--        f bad set [] = [[] | bad == 0]-        f bad set ((i,x):xs)-            | i == ind = map (res:) $ f bad set xs-            | i == 0 = [r:rs | r <- x, rs <- f bad set xs]-            | otherwise =-                (if bad > 0 then f (bad-1) set xs else []) ++-                [r:rs | r <- x, let rp = resultArgPos r, not $ rp `IntSet.member` set-                      , rs <- f bad (IntSet.insert rp set) xs]---newGraphsResults :: Instances -> EntryInfo -> Once EntryInfo -> [ResultArg] -> ResultArg -> Maybe Result-newGraphsResults is query e args res = do-    b <- mergeBindings $ map resultArgBind $ args ++ [res]-    let aps = map resultArgPos args-        s = newTypeScore is query (fromOnce 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 
@@ -1,78 +0,0 @@---module Hoogle.DataBase.TypeSearch.TypeScore(-    TypeScore, newTypeScore, costTypeScore, costsTypeScore-    ) where--import General.Base-import Hoogle.Score.All-import Hoogle.DataBase.TypeSearch.Binding-import Hoogle.DataBase.TypeSearch.EntryInfo-import Hoogle.DataBase.Instances-import Hoogle.Type.All---data TypeScore = TypeScore-    {costTypeScore :: !Int-    ,badargs :: Int-    ,badorder :: Bool-    ,bind :: Binding-    ,badInstance :: (TypeContext, TypeContext)-    ,badAlias :: ([String], [String])-    }---instance Show TypeScore where-    show t = unwords $-             ['#' : show (costTypeScore t)] ++-             replicate (badargs t) "badarg" ++-             ["badorder" | badorder t] ++-             [show $ bind t] ++-             both inst (badInstance t) ++-             both alis (badAlias t)-        where-            both f (a,b) = map (f "+") a ++ map (f "-") b-            inst op (c,v) = c ++ op ++ v-            alis op c = op ++ c---instance Eq TypeScore where-    (==) = (==) `on` costTypeScore--instance Ord TypeScore where-    compare = comparing costTypeScore---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)--        diff a b = (a \\ b, b \\ a)-        ctx = nub $ concat [f c b | (c,v) <- entryInfoContext result, (b, TVar a) <- bindings bs, a == v]-        f c (TVar v) = [(c,v)]-        f c (TLit l) = [(c,l) | not $ hasInstance is c l]---calcScore :: TypeScore -> Int-calcScore t = costBinding (bind t) + sum (map cost $ costsTypeScoreLocal t)---costsTypeScoreLocal :: TypeScore -> [TypeCost]-costsTypeScoreLocal t =-    CostDeadArg *+ badargs t ++-    [CostArgReorder | badorder t] ++-    CostAliasFwd *+ length (fst $ badAlias t) ++-    CostAliasBwd *+ length (snd $ badAlias t) ++-    CostInstanceAdd *+ length (fst $ badInstance t) ++-    CostInstanceDel *+ length (snd $ badInstance t)-    where (*+) = flip replicate---costsTypeScore :: TypeScore -> [TypeCost]-costsTypeScore t = costsBinding (bind t) ++ costsTypeScoreLocal t
− src/Hoogle/DataBase2/Str.hs 
@@ -1,76 +0,0 @@-{-# LANGUAGE RecordWildCards #-}--module Hoogle.DataBase2.Str(-    createStr', searchStr',-    createStr, mergeStr, searchStr-    ) where--import General.Base-import Hoogle.DataBase2.Type-import Hoogle.Type.All-import Hoogle.Score.All-import General.Util-import Data.Binary-import System.IO.Unsafe-import System.FilePath-import qualified General.FMIndex as FM-import qualified Data.ByteString.Char8 as BS---data Strs = Strs-    {posMaximum :: Pos-    ,posOffset :: [(Package, Pos)]-    ,fmIndex :: FM.FMIndex Pos-    } deriving Show--posResolve :: Strs -> Pos -> (Package, Pos)-posResolve Strs{..} p = f posOffset-    where-        f [(pkg,off)] = (pkg,p-off)-        f ((p1,o1):(p2,o2):rest)-            | p < o2 = (p1,p-o1)-            | otherwise = f $ (p2,o2):rest---instance Binary Strs where-    put (Strs a b c) = put a >> put b >> put c-    get = Strs <$> get <*> get <*> get---saveStr :: FilePath -> Strs -> IO ()-saveStr = encodeFile--loadStr :: FilePath -> IO Strs-loadStr = decodeFile---createStr :: Package -> [(Pos, BS.ByteString)] -> FilePath -> IO ()-createStr pkg items file = saveStr file $ Strs (maximum $ 0 : map fst items) [(pkg, 0)] $ FM.create '\0' $ map ((BS.map toLower . snd) &&& fst) items--mergeStr :: [FilePath] -> FilePath -> IO ()-mergeStr xs file = do-    let f mx Strs{..} = (mx + posMaximum, Strs 0 (map (second (+mx)) posOffset) (fmap (+mx) fmIndex))-    (mx,xs) <- mapAccumL f 0 <$> mapM loadStr xs-    saveStr file $ Strs mx (concatMap posOffset xs) (FM.create '\0' $ concatMap (FM.extract . fmIndex) xs)---searchStr :: [FilePath] -> BS.ByteString -> IO [(Package, Pos, [EntryView], Score)]-searchStr files x = do-    files <- mapM loadStr files-    let locate (how1,how2) =-            [ ((pkg,pos),(pkg,pos,[FocusOn $ BS.unpack x],textScore how2))-            | file <- files-            , ((pkg,pos),_) <- map (first $ posResolve file) $ FM.locate (fmIndex file) how1 $ BS.map toLower x]-    return $ map snd $ nubOrdOn fst $ concatMap locate [(FM.Exact,MatchExact), (FM.Prefix,MatchPrefix), (FM.Infix,MatchSubstr)]--------------------------------------------------------------------------createStr' :: Package -> [(Pos, Entry)] -> FilePath -> IO ()-createStr' pkg items out = createStr pkg (mapMaybe f items) out-    where f (pos, Entry{..}) = if null entryKey then Nothing else Just (pos, BS.pack entryKey)--searchStr' :: (String -> Word32 -> IO Entry) -> [FilePath] -> String -> IO [Result]-searchStr' resolve files x = do-    res <- searchStr (map (<.> "str") files) $ BS.pack x-    return $ flip map res $ \(Package a,Pos b,c,d) -> Result (unsafePerformIO $ resolve (BS.unpack a) b) c d
− src/Hoogle/DataBase2/Type.hs 
@@ -1,15 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--module Hoogle.DataBase2.Type where--import Data.Binary-import qualified Data.ByteString.Char8 as BS-import Foreign.Storable--newtype Pos = Pos Word32 deriving (Binary,Eq,Ord,Num,Show,Storable)--newtype Package = Package BS.ByteString deriving (Binary,Ord,Eq,Show)---newPackage :: String -> Package-newPackage = Package . BS.pack
− src/Hoogle/Language/Haskell.hs 
@@ -1,274 +0,0 @@-{-# LANGUAGE PatternGuards #-}--module Hoogle.Language.Haskell(parseInputHaskell) where--import General.Base-import General.Util-import System.FilePath-import Hoogle.Type.All-import Language.Haskell.Exts.Annotated hiding (TypeSig,Type)-import qualified Language.Haskell.Exts.Annotated as HSE-import Data.Generics.Uniplate.Data---type S = SrcSpanInfo---parseInputHaskell :: HackageURL -> String -> ([ParseError], Input)-parseInputHaskell hackage = join . f [] "" . zip [1..] . lines-    where-        f com url [] = []-        f com url ((i,s):is)-            | "-- | " `isPrefixOf` s = f [drop 5 s] url is-            | "--" `isPrefixOf` s = f ([dropWhile isSpace $ drop 2 s | com /= []] ++ com) url is-            | "@url " `isPrefixOf` s =  f com (drop 5 s) is-            | all isSpace s = f [] "" is-            | otherwise = (case parseLine hackage i s of-                               Left y -> Left y-                               Right (as,bs) -> Right (as,[b{itemURL=if null url then itemURL b else url, itemDocs=unlines $ reverse com} | b <- bs]))-                          : f [] "" is--        join xs = (err, (concat as, ripple setPriority $ ripple setModuleURL $ concat bs))-            where (err,items) = unzipEithers xs-                  (as,bs) = unzip items---parseLine :: HackageURL -> Int -> String -> Either ParseError ([Fact],[TextItem])-parseLine _ line x | "(##)" `isPrefixOf` x = Left $ parseErrorWith line 1 "Skipping due to HSE bug #206" "(##)"-parseLine url line ('@':str) = case a of-        "entry" | b <- words b, b /= [] -> Right $ itemEntry b-        "package" | [b] <- words b, b /= "" -> Right $ itemPackage url b-        _ -> Left $ parseErrorWith line 2 ("Unknown attribute: " ++ a) $ '@':str-    where (a,b) = break isSpace str-parseLine _ line x | ["module",a] <- words x = Right $ itemModule $ split '.' a-parseLine _ line x-    | not continue = res-    | otherwise = fromMaybe res $ fmap Right $ parseTuple x `mappend` parseCtor x-    where (continue,res) = parseFunction line x--parseFunction line x = case parseDeclWithMode defaultParseMode{extensions=exts} $ x ++ ex of-    ParseOk y -> (,) False $ maybe (Left $ parseErrorWith line 1 "Can't translate" $ x ++ ex) Right $ transDecl x y-    ParseFailed pos msg -> (,) True $ Left $ parseErrorWith line (srcColumn pos) msg $ x ++ ex-    where ex = if "newtype " `isPrefixOf` x then " = N T" else " " -- space to work around HSE bug #205--parseTuple o@('(':xs) | ")" `isPrefixOf` rest-    , ParseOk y <- parseDeclWithMode defaultParseMode{extensions=exts} $ replicate (length com + 2) 'a' ++ drop 1 rest-    = transDecl o $ f y-    where-        (com,rest) = span (== ',') xs-        f (HSE.TypeSig sl [Ident sl2 _] ty) = HSE.TypeSig sl [Ident sl2 $ '(':com++")"] ty-parseTuple _ = Nothing--parseCtor x = case parseDeclWithMode defaultParseMode{extensions=exts} $ "data Data where " ++ x of-        ParseOk y -> transDecl x $ fmap (subtractCols 16) y-        _ -> Nothing--exts = map EnableExtension-    [EmptyDataDecls,TypeOperators,ExplicitForAll,GADTs,KindSignatures,MultiParamTypeClasses-    ,TypeFamilies,FlexibleContexts,FunctionalDependencies,ImplicitParams,MagicHash,UnboxedTuples]---subtractCols :: Int -> SrcSpanInfo -> SrcSpanInfo-subtractCols n (SrcSpanInfo x xs) = SrcSpanInfo (f x) (map f xs)-    where f x = x{srcSpanStartColumn=srcSpanStartColumn x - n, srcSpanEndColumn=srcSpanEndColumn x - n}---textItem = TextItem 2 UnclassifiedItem "" "" Nothing (Str "") "" "" 0--fact x y = (x,[y])--itemPackage hackageUrl x = fact [] $ textItem{itemLevel=0, itemKey="", itemName=x,-    itemKind=PackageItem,-    itemURL= hackageUrl ++ "package/" ++ x ++ "/",-    itemDisp=Tags [emph "package",space,bold x]}--itemEntry (x:xs) = fact [] $ textItem{itemName=y, itemKey=y,-    itemDisp= if null xs then bold x else Tags [emph x,space,bold y]}-    where y = if null xs then x else unwords xs--itemModule xs = fact [] $ textItem{itemLevel=1, itemKey=last xs, itemName=intercalate "." xs,-    itemURL="", itemKind=ModuleItem,-    itemDisp=Tags [emph "module",Str $ " " ++ concatMap (++".") (init xs),bold $ last xs]}----- apply things that need to ripple down, priorities and module URL's-ripple :: (Maybe TextItem -> Maybe TextItem -> TextItem -> TextItem) -> [TextItem] -> [TextItem]-ripple f = fs Nothing Nothing-    where-        fs a b [] = []-        fs a b (x:xs) = f a2 b2 x : fs a2 b2 xs-            where a2 = if itemLevel x == 0 then Just x else a-                  b2 = if itemLevel x == 1 then Just x else b----- base::Prelude is priority 0--- base, but not inside GHC is priority 1--- Everything else is priority 2-setPriority pkg mod x = x{itemPriority = pri}-    where pri = if pkg2 == "base" && not ("GHC." `isPrefixOf` mod2) then (if mod2 == "Prelude" then 0 else 1) else 2-          mod2 = maybe "" itemName mod-          pkg2 = maybe "" itemName pkg---setModuleURL (Just pkg) _ x | itemLevel x == 1 = x{itemURL=if null $ itemURL x then f $ itemName x else itemURL x}-    where f xs = if "http://hackage.haskell.org/package/" `isPrefixOf` itemURL pkg-                 then "http://hackage.haskell.org/packages/archive/" ++ itemName pkg ++ "/latest/doc/html/" ++ file-                 else takeDirectory (itemURL pkg) ++ "/" ++ file-              where file = reps '.' '-' xs ++ ".html"-setModuleURL _ _ x = x--------------------------------------------------------------------------- TRANSLATE THINGS---transDecl :: String -> Decl S -> Maybe ([Fact],[TextItem])-transDecl x (GDataDecl s dat ctxt hd _ [] _) = transDecl x $ DataDecl s dat ctxt hd [] Nothing-transDecl x (GDataDecl _ _ _ _ _ [GadtDecl s name _ ty] _) = transDecl x $ HSE.TypeSig s [name] ty--transDecl x (HSE.TypeSig _ [name] tyy) = Just $ fact (ctr++kinds False typ) $ textItem{itemName=nam,itemKey=nam,-    itemType=Just typ, itemKind=kind,-    itemURL="#v:" ++ esc nam,-    itemDisp=formatTags x $ (cols snam,TagBold) : zipWith (\i a -> (cols a,TagColor i)) [1..] as ++ [(cols b,TagColor 0)]}-    where (snam,nam) = findName name-          (as,b) = initLast $ typeArgsPos tyy-          ctr = [FactCtorType nam y | ctorStart $ head nam, TLit y <- [fst $ fromTApp $ last $ fromTFun ty]]-          typ@(TypeSig _ ty) = transTypeSig tyy--          ctorStart x = isUpper x || x `elem` ":("-          kind | ctorStart $ head nam = DataCtorItem-               | otherwise = FunctionItem-transDecl x (HSE.TypeSig o names tyy) = fmap f $ sequence [transDecl x $ HSE.TypeSig o [name] tyy | name <- names]-    where f xs = (concatMap fst xs, concatMap snd xs)--transDecl x (ClassDecl s ctxt hd _ _) = Just $ fact (kinds True $ transDeclHead ctxt hd) $ textItem-    {itemName=nam, itemKey=nam, itemKind=ClassItem-    ,itemURL="#t:" ++ esc nam-    ,itemDisp=x `formatTags` [(cols $ head $ srcInfoPoints s, TagEmph),(cols snam,TagBold)]}-    where (snam,nam) = findName hd--transDecl x (TypeDecl s hd ty) = Just $ fact (FactAlias from to:kinds False from++kinds False to) $ textItem-    {itemName=nam, itemKey=nam, itemKind=TypeSynonymItem-    ,itemURL="#t:" ++ esc nam-    ,itemDisp=x `formatTags` [(cols $ head $ srcInfoPoints s, TagEmph),(cols snam,TagBold)]}-    where (snam,nam) = findName hd-          from = transDeclHead Nothing hd-          to = transTypeSig ty--transDecl x (DataDecl _ dat ctxt hd _ _) = Just $ fact (kinds False $ transDeclHead ctxt hd) $ textItem-    {itemName=nam, itemKey=nam, itemKind=TypeCtorItem-    ,itemURL="#t:" ++ esc nam-    ,itemDisp=x `formatTags` [(cols $ srcInfoSpan $ ann dat, TagEmph),(cols snam,TagBold)]}-    where (snam,nam) = findName hd--transDecl x (InstDecl _ _ hd _) = Just (FactInstance t:kinds True t, [])-    where t = transInstRule hd--transDecl _ _ = Nothing---esc = concatMap f-    where-        f x | isAlphaNum x = [x]-            | otherwise = "-" ++ show (ord x) ++ "-"---typeArgsPos :: HSE.Type S -> [SrcSpan]-typeArgsPos (TyForall _ _ _ x) = typeArgsPos x-typeArgsPos (TyFun _ x y) = srcInfoSpan (ann x) : typeArgsPos y-typeArgsPos (TyParen _ x) = typeArgsPos x-typeArgsPos x = [srcInfoSpan $ ann x]-----cols :: SrcSpan -> (Int,Int)-cols x = (srcSpanStartColumn x - 1, srcSpanEndColumn x - 1)--findName :: Data a => a -> (SrcSpan,String)-findName x = case universeBi x of-        Ident s x : _ -> (srcInfoSpan s,x)-        Symbol s x : _ -> (srcInfoSpan s,x)--unbracket ('(':xs) | ")" `isSuffixOf` xs && nub ys `notElem` ["",","] = ys-    where ys = init xs-unbracket x = x---transType :: HSE.Type S -> Type-transType (TyForall _ _ _ x) = transType x-transType (TyFun _ x y) = TFun $ transType x : fromTFun (transType y)-transType (TyTuple _ x xs) = tApp (TLit $ "(" ++ h ++ replicate (length xs - 1) ',' ++ h ++ ")") $ map transType xs-    where h = ['#' | x == Unboxed]-transType (TyList _ x) = TApp (TLit "[]") [transType x]-transType (TyApp _ x y) = tApp a (b ++ [transType y])-    where (a,b) = fromTApp $ transType x-transType (TyVar _ x) = TVar $ prettyPrint x-transType (TyCon _ x) = TLit $ unbracket $ prettyPrint x-transType (TyParen _ x) = transType x-transType (TyInfix _ y1 x y2) = TApp (TLit $ unbracket $ prettyPrint x) [transType y1, transType y2]-transType (TyKind _ x _) = transType x-transType (TyPromoted _ _) = TLit "promoted"-transType (TyParArray _ x) = TApp (TLit "[::]") [transType x]-transType (TyEquals _ x y) = TApp (TLit "~") [transType x, transType y]-transType (TySplice _ _) = TLit "splice"-transType (TyBang _ _ x) = transType x--transContext :: Maybe (Context S) -> Constraint-transContext = maybe [] g-    where-        g (CxSingle _ x) = f x-        g (CxTuple _ xs) = concatMap f xs-        g _ = []--        f (ClassA _ x ys) = [TApp (TLit $ unbracket $ prettyPrint x) $ map transType ys]-        f (InfixA s y1 x y2) = f $ ClassA s x [y1,y2]-        f _ = []---transTypeSig :: HSE.Type S -> TypeSig-transTypeSig (TyParen _ x) = transTypeSig x-transTypeSig (TyForall _ _ con ty) = TypeSig (transContext con) $ transType ty-transTypeSig x = TypeSig [] $ transType x---transDeclHead :: Maybe (Context S) -> DeclHead S -> TypeSig-transDeclHead x y = TypeSig (transContext x) $ f y-    where f (DHead _ name) = TLit $ unbracket $ prettyPrint name-          f (DHInfix s a b) = f $ DHApp s (DHead s b) a-          f (DHParen _ x) = f x-          f (DHApp _ a b) = ttApp (f a) [transVar b]--transInstRule :: InstRule S -> TypeSig-transInstRule (IParen _ x) = transInstRule x-transInstRule (IRule _ _ ctxt hd) = transInstHead ctxt hd--transInstHead :: Maybe (Context S) -> InstHead S -> TypeSig-transInstHead x y = TypeSig (transContext x) $ f y-    where f (IHCon _ name) = TLit $ unbracket $ prettyPrint name-          f (IHInfix s x y) = f $ IHApp s (IHCon s y) x-          f (IHParen _ x) = f x-          f (IHApp _ t x) = ttApp (f t) [transType x]--transVar :: TyVarBind S -> Type-transVar (KindedVar _ nam _) = TVar $ prettyPrint nam-transVar (UnkindedVar _ nam) = TVar $ prettyPrint nam--------------------------------------------------------------------------emph = TagEmph . Str-bold = TagBold . Str-space = Str " "----- collect the kind facts, True for the outer fact is about a class-kinds :: Bool -> TypeSig -> [Fact]-kinds cls (TypeSig x y) = concatMap (f True) x ++ f cls y-    where-        f cls (TApp (TLit c) ys) = add cls c (length ys) ++-                                   if cls then [] else concatMap (f False) ys-        f cls (TLit c) = add cls c 0-        f cls x = if cls then [] else concatMap (f False) $ children x--        add cls c i = [(if cls then FactClassKind else FactDataKind) c i | not $ isTLitTuple c]
− src/Hoogle/Query/All.hs 
@@ -1,7 +0,0 @@--module Hoogle.Query.All(module X) where--import Hoogle.Query.Type     as X-import Hoogle.Query.Parser   as X-import Hoogle.Query.Render   as X-import Hoogle.Query.Suggest  as X
− src/Hoogle/Query/Parser.hs 
@@ -1,229 +0,0 @@-{-# LANGUAGE CPP #-}--module Hoogle.Query.Parser(parseQuery) where--#if __GLASGOW_HASKELL__ < 710-import Control.Applicative ((*>))-#endif-import General.Base-import Hoogle.Query.Type-import Hoogle.Type.All as Hoogle-import Text.ParserCombinators.Parsec hiding (ParseError)-import qualified Text.ParserCombinators.Parsec as Parsec---parseQuery :: String -> Either ParseError Query-parseQuery x = case bracketer x of-    Left err -> Left err-    Right _ -> case parse parsecQuery "" x of-        Left err -> Left $ toParseError x err-        Right x -> Right x---toParseError :: String -> Parsec.ParseError -> Hoogle.ParseError-toParseError src x = parseErrorWith (sourceLine pos) (sourceColumn pos) (show x) src-    where pos = errorPos x---ascSymbols = "->!#$%&*+./<=?@\\^|~:"---optionBool :: Parser a -> Parser Bool-optionBool p = (p >> return True) <|> return False--------------------------------------------------------------------------- QUERY PARSEC--parsecQuery :: Parser Query-parsecQuery = do spaces ; try (end names) <|> (end types)-    where-        end f = do x <- f; eof; return x-    -        names = do a <- many (flag <|> name)-                   b <- option mempty (string "::" >> spaces >> types)-                   let res@Query{names=names} = mappend (mconcat a) b-                       (op,nop) = partition ((`elem` ascSymbols) . head) names-                   if op /= [] && nop /= []-                       then fail "Combination of operators and names"-                       else return res--        handleMatch xs = case xs of-            [x] -> mempty{names=[x]}-            xs -> mempty{names=[last xs]-                        ,scope=[Scope True Module $ intercalate "." $ init xs]}--        name = (do xs <- char '*' *> keyword `sepBy1` (char '.') ; spaces-                   return $ (handleMatch xs) { invertResults = True }-               <|>-               do x <- operator ; spaces ; return mempty{names=[x]})-               <|>-               (do xs <- keyword `sepBy1` (char '.') ; spaces-                   return $ handleMatch xs-               )-        -        operator = between (char '(') (char ')') op <|> op--        op = try $ do-            res <- many1 $ satisfy (`elem` ascSymbols)-            if res == "::" then fail ":: is not an operator name" else return res-        -        types = do a <- flags-                   b <- parsecTypeSig-                   c <- flags-                   return $ mconcat [a,mempty{typeSig=Just b},c]--        flag = try $ do x <- parseFlagScope; spaces; return x-        flags = fmap mconcat $ many flag----- deal with the parsing of:---     -package---     +Module.Name-parseFlagScope :: Parser Query-parseFlagScope = do-    pm <- fmap (== '+') $ oneOf "+-"-    modu <- keyword `sepBy1` (char '.')-    let typ = case modu of [x] | isLower (head x) -> Package; _ -> Module-    return mempty{scope=[Scope pm typ $ intercalate "." modu]}---keyword = do-    x <- letter-    xs <- many $ satisfy $ \x -> isAlphaNum x || x `elem` "_'#-"-    return $ x:xs--------------------------------------------------------------------------- TYPESIG PARSEC--parsecTypeSig :: Parser TypeSig-parsecTypeSig = do whites-                   c <- context-                   t <- typ0-                   return $ normaliseTypeSig $ TypeSig c t-    where-        -- all the parser must swallow up all trailing white space after them-        context = try acontext <|> return []-        -        acontext = do x <- conitems <|> fmap (:[]) conitem-                      white $ string "=>"-                      return x-        -        conitems = between (wchar '(') (wchar ')') $ conitem `sepBy1` wchar ','-        conitem = typ1-        -    -        typ0 = function-        typ1 = application-        typ2 = forAll <|> tuple <|> list <|> atom <|> bang--        bang = wchar '!' >> typ2-        -        forAll = do try (white $ string "forall")-                    many atom-                    wchar '.'-                    TypeSig con typ <- parsecTypeSig-                    return typ---        -- match (a,b) and (,)-        -- also pick up ( -> )-        tuple = do char '('-                   hash <- optionBool $ char '#'-                   let close = white $ string $ ['#'|hash] ++ ")"-                   whites -                   (do wchar ','-                       xs <- many $ wchar ','-                       close-                       return $ tLit hash (length xs + 1)-                    ) <|>-                    (do sym <- white keysymbol-                        close-                        return $ TLit sym-                    ) <|>-                    (do xs <- typ0 `sepBy` wchar ','-                        close-                        return $ case xs of-                            [] -> TLit "()"-                            [x] -> x-                            xs -> TApp (tLit hash $ length xs - 1) xs-                    )-            where-                tLit hash n = TLit $ "(" ++ h ++ replicate n ',' ++ h ++ ")"-                    where h = ['#'|hash]-            -            -        atom = do x <- satisfy (\x -> isAlpha x || x == '_')-                  xs <- many $ satisfy (\x -> isAlphaNum x || x `elem` "_'#")-                  whites-                  return $ (if isLower x || x == '_' then TVar else TLit) (x:xs)--        -- may be [a], or [] (then application takes the a after it)-        list = do char '['-                  colon <- optionBool $ char ':'-                  spaces-                  let close = white $ string $ [':'|colon] ++ "]"-                      lit = TLit $ if colon then "[::]" else "[]"-                  (close >> return lit) <|> (do-                      x <- typ0-                      close-                      return $ TApp lit [x])--        application = do (x:xs) <- many1 (white typ2)-                         return $ TApp x xs--        function = do lhs <- typ1-                      (do op <- white keysymbol; rhs <- function; return $ TApp (TLit op) [lhs,rhs])-                          <|> return lhs--        wchar c = white $ char c-        white x = do y <- x ; whites ; return y--        whites = many whiteChar-        whiteChar = oneOf " \v\f\t\r"--        keysymbol = try $ do-            x <- many1 $ satisfy (\x -> isSymbol x || x `elem` ascSymbols)-            if x `elem` reservedSym then fail "Bad symbol" else return x-        reservedSym = ["::","=>",".","=","#",":","-","+","/","--"]-------------------------------------------------------------------------- BRACKETER--openBrackets = "(["-shutBrackets = ")]"---data Bracket = Bracket Char [Bracket] -- Char is one of '(' or '['-             | NoBracket Char-               deriving Show--bracketer :: String -> Either ParseError [Bracket]-bracketer xs = case readBracket (1,xs) of-    Left (msg,from,to) -> f msg from to-    Right (res,(i,_:_)) -> f "Unexpected closing bracket" i (1+length xs)-    Right (res,_) -> Right res-    where-        f msg from to = Left $ ParseError 1 from msg $ formatTags xs [((from-1,to-1),TagEmph)]---type StrPos = (Int,String)---- Given a list of pos/chars return either a failure (msg,start,end) or some bracket and the remaining chars-readBracket :: StrPos -> Either (String,Int,Int) ([Bracket], StrPos)-readBracket (i,"") = Right ([],(i,""))-readBracket (i, x:xs)-    | x `elem` shutBrackets = Right ([], (i,x:xs))-    | x `elem` openBrackets = case readBracket (i+1,xs) of-        Left e -> Left e-        Right (_, (j,[])) -> Left ("Closing bracket expected", i, j)-        Right (res, (j,y:ys))-            | elemIndex x openBrackets /= elemIndex y shutBrackets -> Left ("Bracket mismatch", i, j+1)-            | otherwise -> case readBracket (j+1,ys) of-                Left e -> Left e-                Right (a,b) -> Right (Bracket x res:a, b)-    | otherwise = case readBracket (i+1,xs) of-        Left e -> Left e-        Right (a,b) -> Right (NoBracket x:a, b)
− src/Hoogle/Query/Render.hs 
@@ -1,37 +0,0 @@--module Hoogle.Query.Render(renderQuery) where--import General.Base-import Data.Generics.Uniplate-import Hoogle.Query.Type-import Hoogle.Type.All----- | Render a query, in particular using 'TagColor' for any type signature argument positions.-renderQuery :: Query -> TagStr-renderQuery x = Tags $ namesig ++ [Str " " | namesig /= [] && scp /= []] ++ scp-    where-        namesig = case (null (names x), isNothing (typeSig x)) of-                      (True, True) -> []-                      (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 = [renderTypeSig $ fromJust $ typeSig x]--        scp = [Str $ unwords $ map f $ scope x | scope x /= []]-        f (Scope b _ x) = (if b then "+" else "-") ++ x---renderTypeSig :: TypeSig -> TagStr-renderTypeSig (TypeSig con args) = Tags $-    Str (showConstraint con) :-    intersperse (Str " -> ")-       (zipWith TagColor [1..] (map (Str . showFun) finit) ++-        [TagColor 0 $ Str $ showFun flast])-    where-        (finit, flast) = (init funcs, last funcs)-        funcs = splitFun args
− src/Hoogle/Query/Suggest.hs 
@@ -1,59 +0,0 @@--module Hoogle.Query.Suggest(suggestQuery) where--import General.Base-import General.Util-import Hoogle.DataBase.All-import Hoogle.Query.Type-import Hoogle.Query.Render-import Hoogle.Type.All---suggestQuery :: [DataBase] -> Query -> Maybe TagStr---- They searched for Google (pay homage)-suggestQuery db q | "google" `elem` map (map toLower) (names q) =-    Just $ Tags [TagLink "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---- They searched for "Int to Float", they meant "Int -> Float"-suggestQuery db q@Query{typeSig=Nothing, names=names}-    | length parts > 1 && all (not . null) parts = Just $ didYouMean q2-    where parts = split "to" names-          q2 = fixup db $ q{names = [] ,typeSig = Just $ TypeSig [] t2}-          t2 = TFun $ map (toApp . map toLitVar) parts---- 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 $ 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: ", TagLink "" $ 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 
@@ -1,52 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--module Hoogle.Query.Type where--import General.Base-import Hoogle.Type.All----- | A query, representing a user input.-data Query = Query-    {names :: [String]-    ,typeSig :: Maybe TypeSig-    ,scope :: [Scope]-    ,exactSearch :: Maybe ItemKind-    ,invertResults :: Bool-    }-    deriving (Data,Typeable,Show,Eq)--instance Monoid Query where-    mempty = Query [] Nothing [] Nothing False-    mappend (Query x1 x2 x3 x4 x5) (Query y1 y2 y3 y4 y5) =-        Query (x1++y1) (x2 `mplus` y2) (x3++y3) (merge x4 y4) (x5 || y5)-      where merge Nothing Nothing = Nothing-            merge (Just x) Nothing = Just x-            merge Nothing (Just y) = Just y-            merge (Just UnclassifiedItem) (Just y) = Just y-            merge (Just x) (Just UnclassifiedItem) = Just x-            merge (Just x) (Just _) = Just x--data Scope = Scope Bool Category String deriving (Data,Typeable,Show,Eq)-data Category = Module | Package deriving (Data,Typeable,Show,Eq)----- | Given a query, return the list of packages that should be searched. Each package will be---   the name of a database, without any file path or extension included.-queryDatabases :: Query -> [String]-queryDatabases q = if null ps then ["default"] else ps-    where ps = [p | Scope True Package p <- scope q]----- | Return those packages which are explicitly excluded (paired with 'False')---   or included (paired with 'True') in the query.-queryPackages :: Query -> [(Bool, String)]-queryPackages q = [(b,s) | Scope b Package s <- scope q]----- | Set the state of a package within a query. 'Nothing' means delete the package,---   'Just' 'True' for add it, and 'Just' 'False' for remove it.-querySetPackage :: Maybe Bool -> String -> Query -> Query-querySetPackage b x q = q{scope = filter f (scope q) ++ [Scope b Package x | Just b <- [b]]}-    where f (Scope _ Package y) = x /= y-          f _ = True
− src/Hoogle/Score/All.hs 
@@ -1,8 +0,0 @@--module Hoogle.Score.All(-    module Hoogle.Score.Scoring,-    Score, TypeCost(..), TextMatch(..), textScore, typeScore, scoreCosts, cost-    ) where--import Hoogle.Score.Scoring-import Hoogle.Score.Type
− src/Hoogle/Score/Scoring.hs 
@@ -1,70 +0,0 @@--module Hoogle.Score.Scoring(scoring) where--import Hoogle.Score.Type-import Data.List-import Control.Arrow-import Data.Ord-import Data.Maybe-import Control.Monad-import System.Random----- | Given a set of scores, where the first is lower than the second, returns details for how to rank scores.---   This function is in the 'IO' monad since it may require randomness, and it may output status messages while solving,---   particularly if in Verbose mode.-scoring :: [(Score,Score)] -> IO String-scoring xs = do-    let cost ys = sum [max 0 $ 1 + vals a - vals b | (a,b) <- xs-                      ,let vals = sum . map (fromRange . fromJust . flip lookup ys) . scoreCosts]-    config <- solveConfig cost [(x::TypeCost, toRange [1..10]) | x <- [minBound..maxBound]]-    return $ unlines ["cost " ++ show a ++ " = " ++ show (fromRange b) | (a,b) <- config]--------------------------------------------------------------------------- SOLVER--type Cost = Int---- zipper on the value-data Range a = Range [a] a [a] deriving Show-toRange (x:xs) = Range [] x xs-fromRange (Range _ x _) = x--type Config = [(TypeCost,Range Int)]--bestConfig f = snd . minimumBy (comparing fst) . map (f &&& id)--nextRange (Range a b c) = [Range as a (b:c) | a:as <- [a]] ++ [Range (b:a) c cs | c:cs <- [c]]-nextConfig = perturb $ \(a,b) -> map ((,) a) $ nextRange b--randomRange (Range x y z) = do-    let xs = reverse x ++ y:z-    i <- randomRIO (0,length xs-1)-    let (x2,y2:z2) = splitAt i xs-    return $ Range (reverse x2) y2 z2--randomConfig = mapM $ \(a,b) -> fmap ((,) a) $ randomRange b----- | Greedy hill climbing to improve a config-improveConfig :: (Config -> Cost) -> Config -> Config-improveConfig f now | f next < f now = improveConfig f next-                    | otherwise = now-    where next = bestConfig f $ nextConfig now----- | Try and minimize the cost of the config-solveConfig :: (Config -> Cost) -> Config -> IO Config-solveConfig f x = fmap (bestConfig f) $ replicateM 25 $ do-    putChar '.'-    y <- randomConfig x-    let z = improveConfig f y-    print (f y,f z)-    return z----- | Perturb one value in the list-perturb :: (a -> [a]) -> [a] -> [[a]]-perturb f [] = [[]]-perturb f (x:xs) = map (:xs) (f x) ++ map (x:) (perturb f xs)
− src/Hoogle/Score/Type.hs 
@@ -1,78 +0,0 @@--module Hoogle.Score.Type(-    Score, TypeCost(..), TextMatch(..),-    textScore, typeScore,-    scoreCosts, cost-    ) where--import General.Base---data TypeCost-    = CostAliasFwd-    | CostAliasBwd-    | CostUnbox-    | CostRebox-    | CostRestrict-    | CostUnrestrict-    | CostDupVarResult-    | CostDupVarQuery-    | CostInstanceDel-    | CostInstanceAdd-    | CostDeadArg-    | CostArgReorder-      deriving (Show,Eq,Ord,Enum,Bounded)--cost :: TypeCost -> Int-cost CostAliasFwd     =    1  -- 1..1000-cost CostAliasBwd     =    1  -- 1..997-cost CostUnbox        =    5  -- 5..1000-cost CostRebox        =    4  -- 4..999-cost CostRestrict     =    5  -- 5..1000-cost CostUnrestrict   =    4  -- 4..1000-cost CostDupVarResult =    4  -- 4..999-cost CostDupVarQuery  =    5  -- 5..1000-cost CostInstanceDel  =    4  -- 4..999-cost CostInstanceAdd  =    4  -- 4..999-cost CostDeadArg      =    3  -- 3..998-cost CostArgReorder   =    1  -- 1..1000---data TextMatch-    = MatchExact-    | MatchPrefix-    | MatchExactCI              -- exact letter match, but case mismatch-    | MatchPrefixCI-    | MatchSubstr-      deriving (Show,Eq,Ord,Enum,Bounded)----- | A score, representing how close a match is. Lower scores are better.-data Score = Score Int [TypeCost] [TextMatch]--instance Monoid Score where-    mempty = Score 0 [] []-    mappend (Score x1 x2 x3) (Score y1 y2 y3) =-        Score (x1+y1) (sort $ x2++y2) (sort $ x3++y3)--textScore :: TextMatch -> Score-textScore x = Score 0 [] [x]--typeScore :: [TypeCost] -> Score-typeScore xs = Score (sum $ map cost xs) (sort xs) []--scoreCosts :: Score -> [TypeCost]-scoreCosts (Score _ x _) = x---instance Show Score where-    show (Score _ a b) =-        intercalate "+" $ map (drop 4 . show) a ++ map (drop 5 . show) b--instance Eq Score where-    Score x1 x2 [] == Score y1 y2 y3 = [] == y3 || x1 == y1-    Score x1 x2 x3 == Score y1 y2 [] = x3 == [] || x1 == y1-    Score x1 x2 x3 == Score y1 y2 y3 = head x3 == head y3 || x1 == y1--instance Ord Score where-    compare (Score x1 x2 x3) (Score y1 y2 y3) = compare (x3,x1) (y3,y1)
− src/Hoogle/Search/All.hs 
@@ -1,37 +0,0 @@--module Hoogle.Search.All(search) where--import Data.List (sortBy)-import Data.Maybe-import Data.Ord (comparing)-import Hoogle.DataBase.All-import Hoogle.Query.All-import Hoogle.Search.Results-import Hoogle.Type.All-import Hoogle.Store.All----- return all the results, lazily-search :: [DataBase] -> Query -> [Result]-search databases query = getResults query databases---getResults :: Query -> [DataBase] -> [Result]-getResults query = sortBy ((if invertResults query then flip else id)-                           $ comparing resultScore) .-                   mergeDataBaseResults . map (mergeQueryResults query . f)-    where-        f d = [ typeSearch d q-              | Just q <- [typeSig query], isNothing (exactSearch query) ] ++-              map (nameSearch d (exactSearch query)) (names query)---nameSearch :: DataBase -> Maybe ItemKind -> String -> [Result]-nameSearch db kind query =-    [ Result (fromOnce e) [v] s-    | (e,v,s) <- (maybe searchName searchExactName kind) db query ]---typeSearch :: DataBase -> TypeSig -> [Result]-typeSearch db query = [Result (fromOnce e) v s-                      | (e,v,s) <- searchType db query]
− src/Hoogle/Search/Results.hs 
@@ -1,98 +0,0 @@--module Hoogle.Search.Results(-    mergeDataBaseResults, mergeQueryResults-    ) where--import General.Base-import General.Util-import qualified Data.Map as Map-import Hoogle.Store.All--import Hoogle.Type.All-import Hoogle.Query.All--------------------------------------------------------------------------- KEYS--data Key k v = Key k v--instance Eq k => Eq (Key k v) where-    Key k1 v1 == Key k2 v2 = k1 == k2--instance Ord k => Ord (Key k v) where-    compare (Key k1 v1) (Key k2 v2) = compare k1 k2--toKey f v = Key (f v) v-fromKey (Key k v) = v--------------------------------------------------------------------------- MERGE DATABASE--mergeDataBaseResults :: [[Result]] -> [Result]-mergeDataBaseResults = map fromKey . fold [] merge . map (map $ toKey f)-    where f r = (resultScore r, entryScore $ resultEntry r)--------------------------------------------------------------------------- MERGE QUERY---- each query is correct, elements can be ordered by entry Id-mergeQueryResults :: Query -> [[Result]] -> [Result]-mergeQueryResults q = filterResults q . joinResults----- join the results of multiple searches--- FIXME: this looks like a disaster - fully strict-joinResults :: [[Result]] -> [Result]-joinResults [] = []-joinResults [x] = x-joinResults xs = Map.elems $ fold1 (Map.intersectionWith join) $-                 map asSet xs-    where-        asSet = Map.fromList . map (entryUnique . resultEntry &&& id)--        join r1 r2 = r1{resultScore = resultScore r1 <> resultScore r2-                       ,resultView = resultView r1 ++ resultView r2-                       ,resultEntry = resultEntry r1 `entryJoin` resultEntry r2}--------------------------------------------------------------------------- FILTER---- | Apply the PlusModule, MinusModule and MinusPackage modes-filterResults :: Query -> [Result] -> [Result]-filterResults q = f mods (correctModule (exactSearch q)) . f pkgs correctPackage-    where-        f [] act = id-        f xs act = filter (act xs . resultEntry)--        mods = [x | x@(Scope _ Module _) <- scope q]-        pkgs = [x | Scope False Package x <- scope q]----- pkgs is a non-empty list of MinusPackage values-correctPackage :: [String] -> Entry -> Bool-correctPackage pkgs x = null myPkgs || any (maybe True (`notElem` map (map toLower) pkgs)) myPkgs-    where myPkgs = map (fmap (map toLower . entryName . fromOnce) . listToMaybe . snd) $ entryLocations x----- mods is a non-empty list of PlusModule/MinusModule-correctModule :: Maybe ItemKind -> [Scope] -> Entry -> Bool-correctModule kind mods x = null myMods || any (maybe True (f base mods)) myMods-    where-        myMods = map (fmap (map (if isJust kind then id else toLower)-                            . entryName . fromOnce)-                      . listToMaybe . drop 1 . snd) $ entryLocations x-        base = case head mods of Scope False Module _ -> True; _ -> False--        f z [] y = z-        f z (Scope b Module x:xs) y-            | doesMatch (map (if isJust kind then id else toLower) x) y = f b xs y-        f z (x:xs) y = f z xs y--        -- match if x is a module starting substring of y-        doesMatch x y = if isJust kind-                        then x == y-                        else x `isPrefixOf` y || ('.':x) `isInfixOf` y
− src/Hoogle/Store/All.hs 
@@ -1,210 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--module Hoogle.Store.All(-    SPut, SGet, runSPut, runSGet, runSGetAt, runAfter,-    Once, fromOnce, once, findOnce, unsafeFmapOnce, getDefer, putDefer,-    module Hoogle.Store.All-    ) where--import General.Base-import Foreign(sizeOf)-import Hoogle.Store.Type-import qualified Data.Map as Map-import qualified Data.ByteString as BS-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import Data.Array---class Store a where-    put :: a -> SPut ()-    get :: SGet a---    -- FIXME: unnecessary, just do an accumulator building up in reverse-    getList :: Int -> SGet [a]-    getList n = replicateM n get--    putList :: [a] -> SPut ()-    putList = mapM_ put--    size :: a -> Maybe Int -- may not look at the size argument-    size _ = Nothing---newtype Defer a = Defer {fromDefer :: a}--instance NFData a => NFData (Defer a) where rnf = rnf . fromDefer-instance Eq a => Eq (Defer a) where a == b = fromDefer a == fromDefer b-instance Ord a => Ord (Defer a) where compare a b = compare (fromDefer a) (fromDefer b)-instance Show a => Show (Defer a) where show = show . fromDefer--instance (Typeable a, Store a) => Store (Defer a) where-    put = putDefer . put . fromDefer-    get = fmap Defer $ getDefer get-    size _ = Just 4---instance Eq a => Eq (Once a) where a == b = fromOnce a == fromOnce b-instance Ord a => Ord (Once a) where compare a b = compare (fromOnce a) (fromOnce b)-instance Show a => Show (Once a) where show = show . fromOnce--instance (Typeable a, Store a) => Store (Once a) where-    put = putOnce put-    get = getOnce get-    size _ = Just 4---errorSGet :: String -> SGet a-errorSGet typ = error $ "Store.get(" ++ typ ++ "), corrupt database"---get0 f = return f-get1 f = do x1 <- get; return (f x1)-get2 f = do x1 <- get; x2 <- get; return (f x1 x2)-get3 f = do x1 <- get; x2 <- get; x3 <- get; return (f x1 x2 x3)-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)-get8 f = do x1 <- get; x2 <- get; x3 <- get; x4 <- get; x5 <- get; x6 <- get; x7 <- get; x8 <- get; return (f x1 x2 x3 x4 x5 x6 x7 x8)-get9 f = do x1 <- get; x2 <- get; x3 <- get; x4 <- get; x5 <- get; x6 <- get; x7 <- get; x8 <- get; x9 <- get; return (f x1 x2 x3 x4 x5 x6 x7 x8 x9)---put0 = return () :: SPut ()-put1 x1 = put x1-put2 x1 x2 = put x1 >> put x2-put3 x1 x2 x3 = put x1 >> put x2 >> put x3-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-put8 x1 x2 x3 x4 x5 x6 x7 x8 = put x1 >> put x2 >> put x3 >> put x4 >> put x5 >> put x6 >> put x7 >> put x8-put9 x1 x2 x3 x4 x5 x6 x7 x8 x9 = put x1 >> put x2 >> put x3 >> put x4 >> put x5 >> put x6 >> put x7 >> put x8 >> put x9---putByte :: Word8 -> SPut (); putByte = put-getByte :: SGet Word8; getByte = get-putWord32 :: Word32 -> SPut (); putWord32 = put-getWord32 :: SGet Word32; getWord32 = get---instance Store Word8 where-    put = putStorable-    get = getStorable-    size = Just . sizeOf--instance Store Word32 where-    put = putStorable-    get = getStorable-    size = Just . sizeOf--instance Store Int32 where-    put = putStorable-    get = getStorable-    size = Just . sizeOf--instance Store Int where-    put x = putStorable (fromIntegral x :: Int32)-    get = fmap fromIntegral (getStorable :: SGet Int32)-    size _ = size (0 :: Int32)--instance Store Char where-    put x | x < '\x80' = putByte . fromIntegral . ord $ x -- ASCII-          | otherwise  = putByteString . T.encodeUtf8 . T.singleton $ x-    get = do c0 <- getByte-             n <- case c0 of-               _ | c0 < 0x80 -> return 0 -- ASCII-               _ | c0 < 0xc0 -> fail "invalid UTF8 sequence"-               _ | c0 < 0xe0 -> return 1-               _ | c0 < 0xf0 -> return 2-               _ | c0 < 0xf8 -> return 3-               _ | c0 < 0xfc -> return 4-               _ | c0 < 0xfe -> return 5--             if n > 0-              then fmap (T.head . T.decodeUtf8 . BS.cons c0) $ getByteString n-              else return $ chr $ fromIntegral $ c0 -- ASCII--    putList = putByteString . T.encodeUtf8 . T.pack--instance Store Bool where-    put x = put $ if x then '1' else '0'-    get = fmap (== '1') get-    size _ = size '1'--instance Store () where-    put () = return ()-    get = return ()-    size _ = Just 0--instance (Store a, Store b) => Store (a,b) where-    put (a,b) = put2 a b-    get = get2 (,)-    size ~(a,b) = liftM2 (+) (size a) (size b)--instance (Store a, Store b, Store c) => Store (a,b,c) where-    put (a,b,c) = put3 a b c-    get = get3 (,,)-    size ~(a,b,c) = liftM3 (\a b c -> a + b + c) (size a) (size b) (size c)--instance Store a => Store (Maybe a) where-    put Nothing = putByte 0-    put (Just a) = putByte 1 >> put a--    get = do i <- getByte-             case i of-                0 -> get0 Nothing-                1 -> get1 Just-                _ -> errorSGet "Maybe"--instance (Store a, Store b) => Store (Either a b) where-    put (Left a) = putByte 0 >> put a-    put (Right a) = putByte 1 >> put a--    get = do i <- getByte-             case i of-                0 -> get1 Left-                1 -> get1 Right-                _ -> errorSGet "Either"----- strategy: write out a byte, 255 = length is an int, anything else = len-instance Store a => Store [a] where-    put xs = do-        let n = fromIntegral (length xs)-        let mx = maxBound :: Word8-        if n >= fromIntegral mx then putByte mx >> putWord32 n else putByte (fromIntegral n)-        putList xs--    get = do-        n <- getByte-        n <- if n == maxBound then getWord32 else return $ fromIntegral n-        getList $ fromIntegral n---instance Store BS.ByteString where-    put x = do-        putWord32 $ fromIntegral $ BS.length x-        putByteString x-    get = do-        n <- getWord32-        getByteString n---instance (Ix i, Store i, Store e) => Store (Array i e) where-    put x = do-        put $ bounds x-        putList $ elems x--    get = do-        bnd <- get-        fmap (listArray bnd) $ case size (undefined :: e) of-            Nothing -> getList $ rangeSize bnd-            Just sz -> getLazyList get sz (rangeSize bnd)---instance (Typeable k, Typeable v, Ord k, Store k, Store v) => Store (Map.Map k v) where-    put = putDefer . put . Prelude.map (second Defer) . Map.toAscList--    get = getDefer $ fmap (Map.fromAscList . Prelude.map (second fromDefer)) get
− src/Hoogle/Store/ReadBuffer.hs 
@@ -1,43 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, RecordWildCards #-}--module Hoogle.Store.ReadBuffer(-    Buffer, newBuffer,-    setPos, getPos,-    getStorable, getByteString,-    ) where--import General.Base-import General.System-import Foreign-import qualified Data.ByteString as BS---bufferSize = 100 :: Int--data Buffer = Buffer {handle :: Handle, fptr :: ForeignPtr ()}--newBuffer :: Handle -> IO Buffer-newBuffer handle = do-    ptr <- mallocForeignPtrBytes bufferSize-    return $ Buffer handle ptr---getPos :: Buffer -> IO Word32-getPos Buffer{..} = fmap fromIntegral $ hTell handle--setPos :: Buffer -> Word32 -> IO ()-setPos b@Buffer{..} pos = do-    hSeek handle AbsoluteSeek $ fromIntegral pos---getStorable :: forall a . Storable a => Buffer -> IO a-getStorable Buffer{..} = do-    let n = sizeOf (undefined :: a)-    when (n > bufferSize) $ error $ "Buffer size overflow in getStorable"-    withForeignPtr fptr $ \ptr -> do-        hGetBuf handle ptr $ sizeOf (undefined :: a)-        peek $ castPtr ptr---getByteString :: Buffer -> Int -> IO BString-getByteString Buffer{..} n = BS.hGet handle n
− src/Hoogle/Store/Type.hs 
@@ -1,209 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}--module Hoogle.Store.Type(-    Once, once, fromOnce, putOnce, getOnce, findOnce, unsafeFmapOnce,-    SPut, runSPut, putByteString, putStorable, putDefer, runAfter,-    SGet, runSGet, runSGetAt, getByteString, getStorable, getDefer, getLazyList-    ) where--import General.Base-import General.System-import Control.Monad.IO.Class-import Control.Monad.Trans.Reader-import qualified Data.IntMap as IntMap-import Data.IORef-import Data.Typeable-import Foreign-import System.IO.Unsafe-import qualified Hoogle.Store.ReadBuffer as R-import qualified Hoogle.Store.WriteBuffer as W----- | Turn on to see file statistics-stats = False----- | All once values are equal with respect to keyOnce---   If you create it with 'once' it will have the same key.---   If two are loaded from a file they are equal.-data Once a = Once {_onceKey :: Int, valueOnce :: a}-              deriving Typeable--unsafeFmapOnce :: (a -> b) -> Once a -> Once b-unsafeFmapOnce f (Once k v) = Once k $ f v--instance NFData a => NFData (Once a) where-    rnf (Once a b) = rnf (a,b)--fromOnce :: Once a -> a-fromOnce = valueOnce---- | Given how many you would like to allocate, return your base address-onceKeys :: Int -> IO Int-onceKeys = System.IO.Unsafe.unsafePerformIO $ do-    ref <- newIORef 0-    return $ \n -> atomicModifyIORef ref $ \x -> (x+n, x)--------------------------------------------------------------------------- PUT--data SPutS = SPutS-    {putBuffer :: W.Buffer-    ,putOnces :: IORef (IntMap.IntMap PutOnce)-    ,putPending :: IORef [SPut ()]-    }--type SPut a = ReaderT SPutS IO a--modifyRef f x = liftIO . (`modifyIORef` x) =<< asks f-readPos = liftIO . W.getPos =<< asks putBuffer---runSPut :: FilePath -> SPut a -> IO a-runSPut file act = withBinaryFile file WriteMode $ \h -> do-    pending <- newIORef []-    once <- newIORef IntMap.empty--    W.withBuffer h $ \buffer -> do-        let flush = do-                xs <- liftIO $ readIORef pending-                liftIO $ writeIORef pending []-                forM_ xs $ \x -> do-                    x-                    flush-        runReaderT (do res <- act; flush; return res) $ SPutS buffer once pending---putByteString :: BString -> SPut ()-putByteString x = do-    buf <- asks putBuffer-    liftIO $ W.putByteString buf x--putStorable :: Storable a => a -> SPut ()-putStorable x = do-    buf <- asks putBuffer-    liftIO $ W.putStorable buf x---putDefer :: SPut () -> SPut ()-putDefer act = do-    pos <- readPos-    putStorable (0 :: Word32)-    modifyRef putPending $ (:) $ do-        val <- readPos-        buf <- asks putBuffer-        liftIO $ W.patch buf pos val-        act--runAfter :: SPut () -> SPut ()-runAfter act = modifyRef putPending (++[act])---{-# NOINLINE once #-}-once :: a -> Once a-once x = System.IO.Unsafe.unsafePerformIO $ do-    key <- onceKeys 1-    return $ Once key x---type PutOnce = Either [Word32] Word32--findOnce :: Once a -> SPut (Maybe Word32)-findOnce (Once key _) = do-    ref <- asks putOnces-    mp <- liftIO $ readIORef ref-    return $ case IntMap.lookup key mp of-        Just (Right val) -> Just val-        _ -> Nothing--putOnce :: (a -> SPut ()) -> Once a -> SPut ()-putOnce act (Once key x) = do-    ref <- asks putOnces-    mp <- liftIO $ readIORef ref-    case fromMaybe (Left []) $ IntMap.lookup key mp of-        -- written out at this address-        Right val -> putStorable val--        -- [] is has not been added to the defer list-        -- (:) is on defer list but not yet written, these are places that need back patching-        Left poss -> do-            pos <- readPos-            liftIO $ writeIORef ref $ IntMap.insert key (Left $ pos:poss) mp-            putStorable (0 :: Word32)-            when (null poss) $ modifyRef putPending $ (:) $ do-                val <- readPos-                mp <- liftIO $ readIORef ref-                let Left poss = mp IntMap.! key-                buf <- asks putBuffer-                liftIO $ forM_ poss $ \pos -> W.patch buf pos val-                liftIO $ writeIORef ref $ IntMap.insert key (Right val) mp-                act x--------------------------------------------------------------------------- GET---- getPtr is the pointer you have, how much is left valid, -data SGetS = SGetS {getBuffer :: R.Buffer, onceBase :: Int}--type SGet a = ReaderT SGetS IO a---runSGet :: Typeable a => FilePath -> SGet a -> IO a-runSGet = runSGetAt 0--runSGetAt :: Typeable a => Word32 -> FilePath -> SGet a -> IO a-runSGetAt pos file m = do-    h <- openBinaryFile file ReadMode-    sz <- hFileSize h-    buf <- R.newBuffer h-    one <- onceKeys $ fromIntegral sz-    runReaderT (getDeferFrom pos m) $ SGetS buf one---getStorable :: Typeable a => Storable a => SGet a-getStorable = do-    buf <- asks getBuffer-    res <- liftIO $ R.getStorable buf-    when stats $ liftIO $ putStrLn $ "Reading storable " ++ show (sizeOf res)-    return res---getByteString :: Word32 -> SGet BString-getByteString len = do-    buf <- asks getBuffer-    when stats $ liftIO $ putStrLn $ "Reading bytestring " ++ show len-    liftIO $ R.getByteString buf $ fromIntegral len---getDefer :: Typeable a => SGet a -> SGet a-getDefer get = do-    pos :: Word32 <- getStorable-    getDeferFrom pos get---getDeferFrom :: forall a . Typeable a => Word32 -> SGet a -> SGet a-getDeferFrom pos get = do-    s <- ask-    liftIO $ unsafeInterleaveIO $ do-        when stats $ putStrLn $ "Read at " ++ show (typeOf (undefined :: a))-        R.setPos (getBuffer s) pos-        runReaderT get s---getOnce :: Typeable a => SGet a -> SGet (Once a)-getOnce get = do-    pos :: Word32 <- getStorable-    x <- getDeferFrom pos get-    one <- asks onceBase-    return $ Once (fromIntegral pos + one) x---getLazyList :: SGet a -> Int -> Int -> SGet [a]-getLazyList get size n = do-    s <- ask-    pos <- liftIO $ R.getPos $ getBuffer s-    liftIO $ forM [0..n-1] $ \i -> unsafeInterleaveIO $ do-        R.setPos (getBuffer s) (pos + fromIntegral (i * size))-        runReaderT get s
− src/Hoogle/Store/WriteBuffer.hs 
@@ -1,97 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, RecordWildCards #-}---- I tried switching to blaze-builder, but this buffer is massively faster-module Hoogle.Store.WriteBuffer(-    Buffer, withBuffer,-    putStorable, putByteString,-    patch, getPos-    ) where--import General.Base-import General.System-import Data.IORef-import Foreign-import qualified Data.ByteString as BS-import qualified Data.ByteString.Internal as BS---bufferSize = 10000 :: Word32----- (number in file, number in buffer)-data Buffer = Buffer-    {handle :: Handle -- the handle we are writing to-    ,ptr :: Ptr () -- the current buffer-    ,inFile :: IORef Word32 -- the number of bytes on the disk-    ,inBuffer :: IORef Word32 -- the number of bytes in the buffer-    ,patchup :: IORef [Patchup]-    }--data Patchup = !Word32 := !Word32--writeRef ref v = v `seq` writeIORef ref v-modifyRef ref f = writeRef ref . f =<< readIORef ref---withBuffer :: Handle -> (Buffer -> IO a) -> IO a-withBuffer handle f = do-    inFile <- newIORef . fromInteger =<< hTell handle-    inBuffer <- newIORef 0-    patchup <- newIORef []-    allocaBytes (fromIntegral bufferSize) $ \ptr -> do-        res <- f $ Buffer handle ptr inFile inBuffer patchup-        inBuf <- readIORef inBuffer-        when (inBuf > 0) $ hPutBuf handle ptr (fromIntegral inBuf)-        xs <- fmap (sortOn $ \(a := b) -> a) $ readIORef patchup-        forM_ xs $ \(pos := val) -> do-            hSeek handle AbsoluteSeek $ toInteger pos-            poke (castPtr ptr) val-            hPutBuf handle ptr $ sizeOf val-        return res---put :: Buffer -> Word32 -> (Handle -> IO ()) -> (Ptr a -> Int -> IO ()) -> IO ()-put _ 0 _ _ = return ()-put Buffer{..} sz toFile toBuffer = do-    inBuf <- readIORef inBuffer-    if inBuf + sz >= bufferSize then do-        when (inBuf > 0) $ hPutBuf handle ptr $ fromIntegral inBuf-        if sz >= bufferSize `div` 2 then do-            toFile handle-            modifyRef inFile (+ (inBuf+sz))-            writeRef inBuffer 0-         else do-            toBuffer (castPtr ptr) 0-            modifyRef inFile (+inBuf)-            writeRef inBuffer sz-     else do-        toBuffer (castPtr ptr) $ fromIntegral inBuf-        writeIORef inBuffer (inBuf+sz)---putStorable :: Storable a => Buffer -> a -> IO ()-putStorable buf x = put buf (fromIntegral sz)-    (\h -> allocaBytes (sizeOf x) $ \ptr -> poke ptr x >> hPutBuf h ptr sz)-    (\ptr pos -> pokeByteOff ptr pos x)-    where sz = sizeOf x---putByteString :: Buffer -> BS.ByteString -> IO ()-putByteString buf x = put buf (fromIntegral $ BS.length x) (`BS.hPut` x) $-    \ptr pos -> let (fp,offset,len) = BS.toForeignPtr x in-                withForeignPtr fp $ \p -> BS.memcpy (plusPtr ptr pos) (plusPtr p offset) (fromIntegral len)---getPos :: Buffer -> IO Word32-getPos Buffer{..} = liftM2 (+) (readIORef inFile) (readIORef inBuffer)----- Patch at position p, with value v. p must be in the past.--- Return True if you succeeded, False if that is already on disk-patch :: Buffer -> Word32 -> Word32 -> IO ()-patch Buffer{..} p v = do-    i <- readIORef inFile-    if p >= i then-        pokeByteOff ptr (fromIntegral $ p-i) v-     else-        modifyRef patchup $ (:) (p := v)
− src/Hoogle/Type/All.hs 
@@ -1,10 +0,0 @@--module Hoogle.Type.All(module X) where--import Hoogle.Type.Docs       as X-import Hoogle.Type.Item       as X-import Hoogle.Type.Language   as X-import Hoogle.Type.ParseError as X-import Hoogle.Type.Result     as X-import Hoogle.Type.TagStr     as X-import Hoogle.Type.TypeSig    as X
− src/Hoogle/Type/Docs.hs 
@@ -1,80 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--module Hoogle.Type.Docs(-    Docs(..), readDocsHTML, renderDocs-    ) where--import General.Base-import Hoogle.Type.TagStr-import Hoogle.Store.All-import Data.ByteString.Char8(ByteString,pack,unpack)-import Data.Binary---newtype Docs = Docs {fromDocs :: ByteString}-    deriving (Eq,Ord,Binary,Monoid)---instance Store Docs where-    put (Docs x) = put1 x-    get = get1 Docs--readDocsHTML :: String -> Docs-readDocsHTML = Docs . pack---renderDocs :: Docs -> TagStr-renderDocs (Docs xs) = tags $ f False $ parseHTML $ unpack xs-    where-        nl = Char '\n'--        -- boolean, are you in a pre block-        f False (Char '\n':Char '\n':xs) = Str "\n\n" : f False (dropWhile (== nl) xs)-        f False (Char '\n':xs) = Str " " : f False xs--        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) = let ys = init $ tail $ f True x-                                 in if null ys then ys else init ys ++ f pre xs-        f pre (Tag "li" x:xs) = Str "\n" : Str "* " : f pre x ++ f pre xs-        f pre (Tag "a" x:xs) = TagLink "" (tags $ f pre x) : f pre xs-        f pre (Tag "i" x:xs) = TagEmph (tags $ f pre x) : f pre xs-        f pre (Tag "em" x:xs) = TagEmph (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-        f pre [] = []---------------------------------------------------------------------------- PARSER--type Tags = [Tag]-data Tag = Char Char | Tag String Tags-           deriving (Eq,Show)--parseHTML :: String -> Tags-parseHTML = fst . readHTML ">"---readHTML :: String -> String -> (Tags, String)-readHTML name = f-    where-        f ('&':'a':'m':'p':';':xs) = g xs $ Char '&'-        f ('&':'g':'t':';':xs) = g xs $ Char '>'-        f ('&':'l':'t':';':xs) = g xs $ Char '<'-        f ('<':'/':xs) | a == name = ([], drop 1 b)-            where (a,b) = break (== '>') xs-        f ('<':xs) | not $ "/" `isPrefixOf` xs = g d $ Tag a c-            where (a,b) = break (== '>') xs-                  (c,d) = readHTML a $ drop 1 b-        f (x:xs) = g xs $ Char x-        f [] = ([],[])--        g rest add = (add:a,b)-            where (a,b) = f rest
− src/Hoogle/Type/Item.hs 
@@ -1,167 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}--module Hoogle.Type.Item where--import General.Base-import General.Util-import Hoogle.Store.All-import Hoogle.Type.Docs-import Hoogle.Type.TagStr-import Hoogle.Type.TypeSig-import Data.Generics.Uniplate---type HackageURL = String--type Input = ([Fact], [TextItem])--data ItemKind = PackageItem-              | ModuleItem-              | FunctionItem-              | DataCtorItem-              | TypeCtorItem-              | TypeSynonymItem-              | ClassItem-              | InstanceItem-              | UnclassifiedItem-              deriving (Data,Typeable,Show,Eq,Enum)--instance NFData ItemKind where-    rnf = rnf . fromEnum--data TextItem = TextItem-    {itemLevel :: Int -- 0 = package, 1 = module, >2 = entry-    ,itemKind :: ItemKind-    ,itemKey :: String -- how i should be searched for (name for most things, last module component for modules)-    ,itemName :: String -- what is the full text representation of me (key for most things, A.B.C for modules)-    ,itemType :: Maybe TypeSig-    ,itemDisp :: TagStr -- TagColor 0 for result type, TagColor 1.. for arg types, TagBold for name-    ,itemURL :: URL-    ,itemDocs :: String-    ,itemPriority :: Int -- priority, 0 is highest priority-    }-    deriving Show--data Fact-    = FactAlias TypeSig TypeSig-    | FactInstance TypeSig-    | FactDataKind String Int-    | FactClassKind String Int-    | FactCtorType String String -- Ctor, Data-      deriving Show----- Invariant: locations will not be empty-data Entry = Entry-    {entryLocations :: [(URL, [Once Entry])]-    ,entryKind :: ItemKind-    ,entryLevel :: Int-    ,entryName :: String-    ,entryText :: TagStr-    ,entryDocs :: Docs-    ,entryPriority :: Int-    ,entryKey :: String -- used only for rebuilding combined databases-    ,entryType :: Maybe TypeSig -- used only for rebuilding combined databases-    }-    deriving (Eq, Typeable)--instance NFData Entry where-    rnf ent@(Entry a b c d e f g h i) = rnf (map (second $ map (f . fromOnce)) a,b,c,d,e,f,g,h,i)-        where f ent2 = if entryUnique ent == entryUnique ent2 then () else rnf ent2----- | Figure out what makes this entry different from others-entryUnique Entry{..} = (entryName, entryText, entryDocs, entryKey, entryType)----- | Join two entries that are equal under entryUnique-entryJoin e1 e2 = e1-    {entryPriority = min (entryPriority e1) (entryPriority e2)-    ,entryLocations = nubOn (map (entryName . fromOnce) . snd) $ concatMap entryLocations $-        if entryScore e1 < entryScore e2 then [e1,e2] else [e2,e1]}---entryURL e = head $ map fst (entryLocations e) ++ [""]---data EntryView = FocusOn String -- characters in the range should be focused-               | ArgPosNum Int Int -- argument a b, a is remapped to b-                 deriving (Eq, Show)---renderEntryText :: [EntryView] -> TagStr -> TagStr-renderEntryText view = transform f-    where-        cols = [(b+1,a+1) | ArgPosNum a b <- view]-        strs = [map toLower x | FocusOn x <- view]--        f (TagColor i x) = maybe x (`TagColor` x) $ lookup i $ [(0,0)|cols/=[]] ++ cols-        f (TagBold (Str xs)) = TagBold $ Tags $ g xs-        f x = x--        g xs | ss /= [] = TagEmph (Str a) : g b-            where ss = filter (`isPrefixOf` map toLower xs) strs-                  (a,b) = splitAt (maximum $ map length ss) xs-        g (x:xs) = Str [x] : g xs-        g [] = []----- 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 entry priority--- the name of the entry, in lower case--- the name of the entry-data EntryScore = EntryScore Int String String-                  deriving (Eq,Ord)---entryScore :: Entry -> EntryScore-entryScore e = EntryScore (entryPriority e) (map toLower $ entryName e) (entryName e)--instance Show Entry where-    show = showTagText . entryText--instance Store Entry where-    put (Entry a b c d e f g h i) = put9 a b c d e f g h i-    get = get9 Entry---instance Store Fact where-    put (FactAlias x y)     = putByte 0 >> put2 x y-    put (FactInstance x)    = putByte 1 >> put1 x-    put (FactDataKind x y)  = putByte 2 >> put2 x y-    put (FactClassKind x y) = putByte 3 >> put2 x y-    put (FactCtorType x y)  = putByte 4 >> put2 x y--    get = do i <- getByte-             case i of-                0 -> get2 FactAlias-                1 -> get1 FactInstance-                2 -> get2 FactDataKind-                3 -> get2 FactClassKind-                4 -> get2 FactCtorType--instance Store ItemKind where-    put PackageItem      = putByte 0-    put ModuleItem       = putByte 1-    put FunctionItem     = putByte 2-    put DataCtorItem     = putByte 4-    put TypeCtorItem     = putByte 5-    put TypeSynonymItem  = putByte 6-    put ClassItem        = putByte 7-    put InstanceItem     = putByte 8-    put UnclassifiedItem = putByte 9--    get = do i <- getByte-             case i of-                0 -> get0 PackageItem-                1 -> get0 ModuleItem-                2 -> get0 FunctionItem-                3 -> get0 FunctionItem-                4 -> get0 DataCtorItem-                5 -> get0 TypeCtorItem-                6 -> get0 TypeSynonymItem-                7 -> get0 ClassItem-                8 -> get0 InstanceItem-                9 -> get0 UnclassifiedItem
− src/Hoogle/Type/Language.hs 
@@ -1,11 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--module Hoogle.Type.Language where--import General.Base----- | The languages supported by Hoogle.-data Language-    = Haskell -- ^ The Haskell language (<http://haskell.org/>), along with many GHC specific extensions.-    deriving (Enum,Read,Show,Eq,Ord,Bounded,Data,Typeable)
− src/Hoogle/Type/ParseError.hs 
@@ -1,24 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--module Hoogle.Type.ParseError where--import Hoogle.Type.TagStr-import Data.Data---- | Data type representing a parse error. All indecies are 1-based.-data ParseError = ParseError-    {lineNo :: Int -- ^ Line number on which the error occured, 1 for the first line of a file.-    ,columnNo :: Int -- ^ Column number on which the error occured, 1 for the first character of a line.-    ,errorMessage :: String -- ^ Error message caused by the parse error.-    ,parseInput :: TagStr -- ^ Input string which caused the error - sometimes with a 'TagEmph' to indicate which part was incorrect.-    } deriving (Ord,Eq,Data,Typeable)--instance Show ParseError where-    show (ParseError line col err _) = "Parse error " ++ show line ++ ":" ++ show col ++ ": " ++ err---parseErrorWith :: Int -> Int -> String -> String -> ParseError-parseErrorWith line col err text = ParseError line col err $ Tags [Str pre, TagEmph $ Str $ post ++ post2]-    where-        (pre,post) = splitAt (col-1) text-        post2 = if null post then "   " else ""
− src/Hoogle/Type/Result.hs 
@@ -1,19 +0,0 @@--module Hoogle.Type.Result where--import Hoogle.Type.TagStr-import Hoogle.Type.Item-import Hoogle.Score.All---data Result = Result-    {resultEntry :: Entry-    ,resultView :: [EntryView]-    ,resultScore :: Score-    }-    deriving (Eq, Show)----- return the entry rendered with respect to the EntryView-renderResult :: Result -> TagStr-renderResult r = renderEntryText (resultView r) $ entryText $ resultEntry r
− src/Hoogle/Type/TagStr.hs 
@@ -1,159 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}---- | A module representing strings with formatting.-module Hoogle.Type.TagStr(-    TagStr(..), tags,-    showTagText, showTagANSI,-    showTagHTML, showTagHTMLWith,-    formatTags-    ) where--import General.Base-import General.Web-import Data.Generics.Uniplate-import Hoogle.Store.All-import qualified Data.Binary as B-import qualified Data.ByteString.Char8 as BS---data TagStr-    = Str String -- ^ Plain text.-    | Tags [TagStr] -- ^ A list of tags one after another.-    | TagBold TagStr -- ^ Bold text.-    | TagEmph TagStr -- ^ Underlined/italic text.-    | TagLink String TagStr -- ^ A hyperlink to a URL.-    | TagColor Int TagStr -- ^ Colored text. Index into a 0-based palette. Text without any 'TagColor' should be black.-      deriving (Data,Typeable,Ord,Show,Eq)--instance B.Binary TagStr where-    put (Str x) = B.putWord8 0 >> B.put (BS.pack x)-    put (Tags x) = B.putWord8 1 >> B.put x-    put (TagBold x) = B.putWord8 2 >> B.put x-    put (TagEmph x) = B.putWord8 3 >> B.put x-    put (TagLink x y) = B.putWord8 4 >> B.put (BS.pack x) >> B.put y-    put (TagColor x y) = B.putWord8 5 >> B.put x >> B.put y--    get = B.getWord8 >>= \x -> case x of-        0 -> Str . BS.unpack <$> B.get-        1 -> Tags <$> B.get-        2 -> TagBold <$> B.get-        3 -> TagEmph <$> B.get-        4 -> do x <- B.get; y <- B.get; return $ TagLink (BS.unpack x) y-        5 -> TagColor <$> B.get <*> B.get--instance NFData TagStr where-    rnf (Str a) = rnf a-    rnf (Tags a) = rnf a-    rnf (TagBold a) = rnf a-    rnf (TagEmph a) = rnf a-    rnf (TagLink a b) = rnf (a,b)-    rnf (TagColor a b) = rnf (a,b)--instance Monoid TagStr where-    mempty = Str ""-    mappend x y = tags [x,y]-    mconcat = tags---instance Uniplate TagStr where-    uniplate (Tags xs) = (xs, Tags)-    uniplate (TagBold x) = ([x], \[x] -> TagBold x)-    uniplate (TagEmph x) = ([x], \[x] -> TagEmph x)-    uniplate (TagLink i x) = ([x], \[x] -> TagLink i x)-    uniplate (TagColor i x) = ([x], \[x] -> TagColor i x)-    uniplate x = ([], const x)---instance Store TagStr where-    put (Str x)        = putByte 0 >> put1 x-    put (Tags x)       = putByte 1 >> put1 x-    put (TagBold x)    = putByte 2 >> put1 x-    put (TagEmph x)    = putByte 3 >> put1 x-    put (TagLink x y)  = putByte 4 >> put2 x y-    put (TagColor x y) = putByte 5 >> put2 x y--    get = do i <- getByte-             case i of-                0 -> get1 Str-                1 -> get1 Tags-                2 -> get1 TagBold-                3 -> get1 TagEmph-                4 -> get2 TagLink-                5 -> get2 TagColor----- | Smart constructor for 'Tags'-tags :: [TagStr] -> TagStr-tags xs = case f xs of-        [x] -> x-        xs -> Tags xs-    where-        f (Str a:Str b:xs) = f $ Str (a++b):xs-        f (x:xs) = x : f xs-        f [] = []----- | Show a 'TagStr' as a string, without any formatting.-showTagText :: TagStr -> String-showTagText x = concat [y | Str y <- universe x]----- | Show a 'TagStr' on a console with ANSI escape sequences.-showTagANSI :: TagStr -> String-showTagANSI x = f [] x-    where-        f a (Str x) = x--        f a t =-            case getCode t of-                Nothing -> g a-                Just val -> tag (val:a) ++ g (val:a) ++ tag a-            where g a = concatMap (f a) (children t)-        -        getCode (TagBold _) = Just "1"-        getCode (TagLink url _) = if null url then Nothing else Just "4"-        getCode (TagEmph _) = Just "4"-        getCode (TagColor n _) | n <= 5 && n >= 0 = Just ['3', intToDigit (n + 1)]-        getCode _ = Nothing--        tag stack = chr 27 : '[' : intercalate ";" ("0":reverse stack) ++ "m"----- | Show a 'TagStr' as HTML, using CSS classes for color styling.-showTagHTML :: TagStr -> String-showTagHTML = showTagHTMLWith (const Nothing)----- | Show TagStr with an override for specific tags.-showTagHTMLWith :: (TagStr -> Maybe String) -> TagStr -> String-showTagHTMLWith f x = g x-    where-        g x | isJust (f x) = fromJust $ f x-        g (Str x) = nbsp $ escapeHTML x-        g (Tags xs) = concatMap g xs-        g (TagBold x) = htmlTag "b" $ showTagHTML x-        g (TagEmph x) = htmlTag "i" $ showTagHTML x-        g (TagLink url x) = "<a href=\"" ++& (if null url then showTagText x else url) ++ "\">" ++ showTagHTML x ++ "</a>"-        g (TagColor i x) = "<span class='c" ++ show i ++ "'>" ++ showTagHTML x ++ "</span>"--        nbsp (' ':' ':xs) = " &nbsp;" ++ nbsp xs-        nbsp (x:xs) = x : nbsp xs-        nbsp [] = []----- each position is a 0-based start and end index--- currently not allowed to overlap-formatTags :: String -> [((Int,Int),TagStr -> TagStr)] -> TagStr-formatTags o y = tags $ f o 0 $ sortBy (comparing $ fst . fst) y-    where-        f x i [] = str x-        f x i (((from,to),op):ss)-            | i > from = error $ "TagStr.formatTags, not allowed overlapping formats on: " ++ o-            | otherwise = str a ++ [op $ Str c] ++ f d to ss-                where (a,b) = splitAt (from-i) x-                      (c,d) = splitAt (to-from) b--        tags [] = Str ""-        tags [x] = x-        tags xs = Tags xs-        str x = [Str x | x /= ""]
− src/Hoogle/Type/TypeSig.hs 
@@ -1,212 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--module Hoogle.Type.TypeSig where--import Hoogle.Store.All-import General.Base-import Data.Generics.UniplateOn--------------------------------------------------------------------------- DATA TYPE WITH CONTEXT----- FULL TYPE-data TypeSig = TypeSig Constraint Type-               deriving (Eq,Ord,Data,Typeable)--instance NFData TypeSig where-    rnf (TypeSig a b) = rnf (a,b)--type Constraint = [Type]----- CONSTRICTED TYPE--- first argument is a list of contexts, (Context,Variable)-type TypeContext = [(String,String)]-data TypeSimp = TypeSimp TypeContext Type-                deriving (Eq,Ord,Data,Typeable)--instance Show TypeSimp where-    show (TypeSimp c t) = show $ TypeSig [TApp (TLit a) [TVar b] | (a,b) <- c] t--------------------------------------------------------------------------- DATA TYPES--data Type = TApp Type [Type] -- a list of types, first one being the constructor-          | TLit String -- bound variables, Maybe, ":", "(,)", "(,,)" (tuple)-          | TVar String -- unbound variables, "a"-          | TFun [Type]-          deriving (Eq,Ord,Data,Typeable)--instance NFData Type where-    rnf (TApp a b) = rnf (a,b)-    rnf (TLit a) = rnf a-    rnf (TVar a) = rnf a-    rnf (TFun a) = rnf a--tApp :: Type -> [Type] -> Type-tApp t [] = t-tApp t ts = TApp t ts--ttApp :: Type -> [Type] -> Type-ttApp t [] = t-ttApp (TApp t ts) ts2 = TApp t (ts++ts2)-ttApp t ts = TApp t ts---fromTFun :: Type -> [Type]-fromTFun (TFun x) = x-fromTFun x = [x]---isTLit, isTVar :: Type -> Bool-isTLit TLit{} = True; isTLit _ = False-isTVar TVar{} = True; isTVar _ = False---fromTApp :: Type -> (Type, [Type])-fromTApp (TApp x y) = (x,y)-fromTApp x = (x,[])---isTLitTuple :: String -> Bool-isTLitTuple x = ',' `elem` x---insertTApp, removeTApp :: Type -> Type-insertTApp = transform f-    where-        f (TApp (TApp x []) y) = TApp x y-        f (TApp x y) = TApp x y-        f (TFun x) = TFun x-        f x = TApp x []--removeTApp = transform f-    where-        f (TApp x []) = x-        f x = x--------------------------------------------------------------------------- UNIPLATE INSTANCES--instance Uniplate Type where-    uniplate (TApp x xs) = (x:xs, \(x:xs) -> TApp x xs)-    uniplate (TFun xs) = (xs, TFun)-    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]--------------------------------------------------------------------------- STORE INSTANCES--instance Store TypeSig where-    put (TypeSig a b) = put2 a b-    get = get2 TypeSig--instance Store Type where-    put (TApp a b) = putByte 0 >> put2 a b-    put (TLit a)   = putByte 1 >> put1 a-    put (TVar a)   = putByte 2 >> put1 a-    put (TFun a)   = putByte 3 >> put1 a--    get = do-        i <- getByte-        case i of-            0 -> get2 TApp-            1 -> get1 TLit-            2 -> get1 TVar-            3 -> get1 TFun--------------------------------------------------------------------------- SHOW INSTANCES--showConstraint :: Constraint -> String-showConstraint [] = ""-showConstraint [x] = show x ++ " => "-showConstraint xs = "(" ++ intercalate ", " (map show xs) ++ ") => "----- TODO: show (TLit ":+:") should be "(:+:)"-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 $ intercalate ", " $ 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-                = "(# " ++ intercalate ", " (map show xs) ++ " #)"--            -            f i (TLit x) = x-            f i (TVar x) = x-            -            f i (TApp x xs) = b (i > 1) $ unwords $ map (f 2) (x:xs)-            f i (TFun xs)   = b (i > 0) $ intercalate " -> " $ map (f 1) xs-            -            b True x = "(" ++ x ++ ")"-            b False x = x---instance Show TypeSig where-    show (TypeSig x xs) = showConstraint x ++ show xs----- shows an element within a function--- to get brackets right after splitFun-showFun :: Type -> String-showFun x = showsPrec 1 x ""--------------------------------------------------------------------------- OPERATIONS--normaliseTypeSig :: TypeSig -> TypeSig-normaliseTypeSig = transformOn onTypeSig normaliseType---normaliseType :: Type -> Type-normaliseType = transform f-    where-        f (TApp x []) = x-        f (TApp (TLit "->") xs) = f $ TFun xs-        f (TFun [x]) = x-        f (TFun xs) = TFun $ g xs-        f x = x--        g [] = []-        g [TFun xs] = g xs-        g (x:xs) = x : g xs---splitFun :: Type -> [Type]-splitFun (TFun xs) = xs-splitFun x = [x]---renameVars :: (String -> String) -> TypeSig -> TypeSig-renameVars f = transformOn onTypeSig g-    where-        g (TVar x) = TVar $ f x-        g x = x
+ src/Input/Cabal.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE ViewPatterns, PatternGuards, TupleSections, RecordWildCards, ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wall -Wno-name-shadowing #-}++-- | Module for reading Cabal files.+module Input.Cabal(+    PkgName, Package(..),+    parseCabalTarball, readGhcPkg,+    packagePopularity, readCabal+    ) where++import Input.Settings++import Data.List.Extra+import System.FilePath+import Control.DeepSeq+import Control.Exception.Extra+import Control.Monad+import System.IO.Extra+import General.Str+import System.Exit+import qualified System.Process.ByteString as BS+import qualified Data.ByteString.UTF8 as UTF8+import System.Directory+import Data.Maybe+import Data.Tuple.Extra+import qualified Data.Map.Strict as Map+import General.Util+import Data.Semigroup+import Control.Applicative+import Prelude++import Distribution.Compat.Lens (toListOf)+import qualified Distribution.PackageDescription as PD+import qualified Distribution.PackageDescription.Configuration as PD+import qualified Distribution.PackageDescription.Parsec as PD+import qualified Distribution.Pretty+import qualified Distribution.Types.BuildInfo.Lens as Lens+import Distribution.Types.PackageName (mkPackageName, unPackageName)+import Distribution.Types.Version (versionNumbers)+import Distribution.Utils.ShortText (fromShortText)+import Hackage.RevDeps (lastVersionsOfPackages)+import qualified Distribution.SPDX as SPDX++---------------------------------------------------------------------+-- DATA TYPE++-- | A representation of a Cabal package.+data Package = Package+    {packageTags :: ![(Str, Str)] -- ^ The Tag information, e.g. (category,Development) (author,Neil Mitchell).+    ,packageLibrary :: !Bool -- ^ True if the package provides a library (False if it is only an executable with no API)+    ,packageSynopsis :: !Str -- ^ The synposis, grabbed from the top section.+    ,packageVersion :: !Str -- ^ The version, grabbed from the top section.+    ,packageDepends :: ![PkgName] -- ^ The list of packages that this package directly depends on.+    ,packageDocs :: !(Maybe FilePath) -- ^ Directory where the documentation is located+    } deriving Show++instance Semigroup Package where+    Package x1 x2 x3 x4 x5 x6 <> Package y1 y2 y3 y4 y5 y6 =+        Package (x1++y1) (x2||y2) (one x3 y3) (one x4 y4) (nubOrd $ x5 ++ y5) (x6 `mplus` y6)+        where one a b = if strNull a then b else a++instance Monoid Package where+    mempty = Package [] True mempty mempty [] Nothing+    mappend = (<>)++instance NFData Package where+    rnf (Package a b c d e f) = rnf (a,b,c,d,e,f)+++---------------------------------------------------------------------+-- POPULARITY++-- | Given a set of packages, return the popularity of each package, along with any warnings+--   about packages imported but not found.+packagePopularity :: Map.Map PkgName Package -> ([String], Map.Map PkgName Int)+packagePopularity cbl = mp `seq` (errs, mp)+    where+        mp = Map.map length good+        errs =  [ unPackageName user ++ ".cabal: Import of non-existant package " ++ unPackageName name +++                          (if null rest then "" else ", also imported by " ++ show (length rest) ++ " others")+                | (name, user:rest) <- Map.toList bad]+        (good, bad)  = Map.partitionWithKey (\k _ -> k `Map.member` cbl) $+            Map.fromListWith (++) [(b,[a]) | (a,bs) <- Map.toList cbl, b <- packageDepends bs]+++---------------------------------------------------------------------+-- READERS++-- | Run 'ghc-pkg' and get a list of packages which are installed.+readGhcPkg :: Settings -> IO (Map.Map PkgName Package)+readGhcPkg settings = do+    topdir <- findExecutable "ghc-pkg"+    (exit, stdout, stderr) <-+    -- From GHC 9.0.1, the `haddock-html` field in `*.conf` files for GHC boot+    -- libraries has used `${pkgroot}`, which can be expanded in the output.++    -- On Windows, the `haddock-html` field in `*.conf` files for GHC boot+    -- libraries for GHC >= 9.0 && < 9.10 contain errors. For example, this may+    -- be specified:+    --+    --     haddock-html: ${pkgroot}/../../doc/html/libraries/base-4.18.0.0+    --+    -- when the correct specification would be:+    --+    --     haddock-html: ${pkgroot}/../doc/html/libraries/base-4.18.0.0+    --+    -- However haddock does not seek to correct that. It assumes that users will+    -- correct manually the affected `*.conf` files.++    -- important to use BS process reading so it's in Binary format, see #194+      BS.readProcessWithExitCode "ghc-pkg" ["dump", "--expand-pkgroot"] mempty+    when (exit /= ExitSuccess) $+        errorIO $ "Error when reading from ghc-pkg, " ++ show exit ++ "\n" ++ UTF8.toString stderr+    let g (stripPrefix "$topdir" -> Just x) | Just t <- topdir = takeDirectory t ++ x+        -- ^ Backwards compatibility with GHC < 9.0+        g x = x+    let fixer p = p{packageLibrary = True, packageDocs = g <$> packageDocs p}+    let f ((stripPrefix "name: " -> Just x):xs) = Just (mkPackageName $ trimStart x, fixer $ readCabal settings $ bstrPack $ unlines xs)+        f _ = Nothing+    pure $ Map.fromList $ mapMaybe f $ splitOn ["---"] $ lines $ filter (/= '\r') $ UTF8.toString stdout+++-- | Given a tarball of Cabal files, parse the latest version of each package.+parseCabalTarball :: Settings -> FilePath -> IO (Map.Map PkgName Package)+parseCabalTarball settings tarfile = do+    lastVersions <- lastVersionsOfPackages (const True) tarfile Nothing+    pure $ Map.map (readCabal settings) lastVersions+++---------------------------------------------------------------------+-- PARSERS++readCabal :: Settings -> BStr -> Package+readCabal settings src = case PD.parseGenericPackageDescriptionMaybe src of+    Nothing -> Package+        { packageTags = []+        , packageLibrary = False+        , packageSynopsis = mempty+        , packageVersion = strPack "0.0"+        , packageDepends = []+        , packageDocs = Nothing+        }+    Just gpd -> readCabal' settings gpd++readCabal' :: Settings -> PD.GenericPackageDescription -> Package+readCabal' Settings{..} gpd = Package{..}+    where+        pd = PD.flattenPackageDescription gpd+        pkgId = PD.package pd++        packageDepends = nubOrd $ foldMap (map (\(PD.Dependency pkg _ _) -> pkg) . PD.targetBuildDepends) $ toListOf Lens.traverseBuildInfos gpd+        packageVersion = strPack $ intercalate "." $ map show $ versionNumbers $ PD.pkgVersion pkgId+        packageSynopsis = strPack $ fromShortText $ PD.synopsis pd+        packageLibrary = PD.hasPublicLib pd+        packageDocs = Nothing++        unpackLicenseExpression (SPDX.EOr x y) = unpackLicenseExpression x ++ unpackLicenseExpression y+        unpackLicenseExpression x = [x]++        packageLicenses = case PD.license pd of+            SPDX.NONE -> []+            SPDX.License licExpr -> map (show . Distribution.Pretty.pretty) $+                unpackLicenseExpression licExpr+        packageCategories =+            filter (not . null) $ split (`elem` " ,") $+                fromShortText $ PD.category pd+        packageAuthor = fromShortText $ PD.author pd+        packageMaintainer = fromShortText $ PD.maintainer pd++        packageTags = map (both strPack) $ nubOrd $ concat+            [ map ("license",) packageLicenses+            , map ("category",) packageCategories+            , map ("author",) (concatMap cleanup [packageAuthor, packageMaintainer])+            ]++        -- split on things like "," "&" "and", then throw away email addresses, replace spaces with "-" and rename+        cleanup =+            filter (/= "") .+            map (renameTag . intercalate "-" . filter ('@' `notElem`) . words . takeWhile (`notElem` "<(")) .+            concatMap (map unwords . split (== "and") . words) . split (`elem` ",&")
+ src/Input/Download.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE TupleSections #-}++module Input.Download(downloadInput, DownloadInput(..)) where++import System.FilePath+import Control.Monad.Extra+import System.Directory+import Data.Conduit.Binary (sinkFile)+import Data.Default.Class+import qualified Network.HTTP.Conduit as C+import Network.Connection+import qualified Data.Conduit as C+import General.Util+import General.Timing+import Control.Monad.Trans.Resource+import Control.Exception.Extra++data DownloadInput =+    AlwaysDownloadInput+    | NeverDownloadInput+    | DownloadInputIfNotThere+++-- | Download all the input files to input/+downloadInput :: Timing -> Bool -> DownloadInput -> FilePath -> String -> URL -> IO FilePath+downloadInput timing insecure download dir name url = do+    let file = dir </> "input-" ++ name+    exists <- doesFileExist file+    let act =+            timed timing ("Downloading " ++ url) $ do+                downloadFile insecure (file <.> "part") url+                renameFile (file <.> "part") file+    case download of+        NeverDownloadInput ->+            unless exists $+              errorIO $ "File is not already downloaded and --download=no given, downloading " ++ url ++ " to " ++ file+        AlwaysDownloadInput -> act+        DownloadInputIfNotThere ->+            unless exists act+    pure file++downloadFile :: Bool -> FilePath -> String -> IO ()+downloadFile insecure file url = do+    let request = C.parseRequest_ url+    manager <- C.newManager $ C.mkManagerSettings+      (TLSSettingsSimple {+        settingDisableCertificateValidation = insecure,+        settingDisableSession = False,+        settingUseServerName = False,+        settingClientSupported = def+      }) Nothing+    runResourceT $ do+        response <- C.http request manager+        C.runConduit $ C.responseBody response C..| sinkFile file
+ src/Input/Haddock.hs view
@@ -0,0 +1,274 @@+{-# LANGUAGE ViewPatterns, PatternGuards, TupleSections, OverloadedStrings, Rank2Types, DeriveDataTypeable, LambdaCase #-}+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -Wno-name-shadowing #-}++module Input.Haddock(parseHoogle, fakePackage, input_haddock_test) where++import Language.Haskell.Exts as HSE+import Data.Char+import Data.List.Extra+import Data.Maybe+import Data.Data+import Input.Item+import Input.ParseDecl+import General.Util+import Control.DeepSeq+import Control.Monad.Trans.Class+import General.Conduit+import Control.Monad.Extra+import Control.Exception.Extra+import General.Str+import Safe+import Distribution.Types.PackageName (unPackageName, mkPackageName)+++-- | An entry in the Hoogle DB+data Entry = EPackage PkgName+           | EModule ModName+           | EDecl (Decl ())+             deriving (Data, Show)+++fakePackage :: PkgName -> String -> (Maybe Target, [Item])+fakePackage name desc = (Just $ Target (hackagePackageURL name) Nothing Nothing "package" (renderPackage name) desc, [IPackage name])++-- | Given a file name (for errors), feed in lines to the conduit and emit either errors or items+parseHoogle :: Monad m => (String -> m ()) -> URL -> LBStr -> ConduitM i (Maybe Target, [Item]) m ()+parseHoogle warning url body = sourceLStr body .| linesCR .| zipFromC 1 .| parserC warning .| hierarchyC url .| mapC (\x -> rnf x `seq` x)++parserC :: Monad m => (String -> m ()) -> ConduitM (Int, BStr) (Target, Entry) m ()+parserC warning = f [] ""+    where+        f com url = do+            x <- await+            whenJust x $ \(i,s) -> case () of+                _ | s == "}" -> f [] ""+                  -- Skip default methods like ($dmliftEq) and ($dmdisplayExceptionAnnotation)+                  | Just{} <- bstrStripPrefix "($dm" s -> f [] ""+                  | Just s <- bstrStripPrefix "-- | " s -> f [ignoreMath s] url+                  | Just s <- bstrStripPrefix "--" s -> f (if null com then [] else bstrTrimStart s : com) url+                  | Just s <- bstrStripPrefix "    --" s -> f (if null com then [] else bstrTrimStart s : com) url+                  | Just s <- bstrStripPrefix "@url " s -> f com (bstrUnpack s)+                  | bstrNull $ bstrTrimStart s -> f [] ""+                  | otherwise -> do+                        case parseLine $ fixLine $ bstrUnpack s of+                            Left y -> lift $ warning $ show i ++ ":" ++ y+                            -- only check Nothing as some items (e.g. "instance () :> Foo a")+                            -- don't roundtrip but do come out equivalent+                            Right [EDecl InfixDecl{}] -> pure () -- can ignore infix constructors+                            Right xs -> forM_ xs $ \x ->+                                yield (Target url Nothing Nothing (typeItem x) (renderItem x) $ reformat $ reverse com, x) -- descendBi stringShare x)+                        f [] ""+++-- See https://github.com/ndmitchell/hoogle/issues/353+-- for functions like `tail` which start <math>.+ignoreMath :: BStr -> BStr+ignoreMath x | Just x <- "&lt;math&gt;" `bstrStripPrefix` x+             = fromMaybe x $ ". " `bstrStripPrefix` x+ignoreMath x = x++typeItem :: Entry -> String+typeItem = \case+    EPackage{} -> "package"+    EModule{} -> "module"+    EDecl{} -> ""++-- FIXME: used to be in two different modules, now does and then undoes lots of stuff+reformat :: [BStr] -> String+reformat = unlines . map bstrUnpack+++hierarchyC :: Monad m => URL -> ConduitM (Target, Entry) (Maybe Target, [Item]) m ()+hierarchyC packageUrl = void $ mapAccumC f (Nothing, Nothing)+    where+        f (_pkg, _mod) (t, EPackage x) = ((Just (unPackageName x, url), Nothing), (Just t{targetURL=url}, [IPackage x]))+            where url = targetURL t `orIfNull` packageUrl+        f (pkg, _mod) (t, EModule x) = ((pkg, Just (strUnpack x, url)), (Just t{targetPackage=pkg, targetURL=url}, [IModule x]))+            where url = targetURL t `orIfNull` (if isGhc then ghcModuleURL x else hackageModuleURL x)+        f (pkg, mod) (_t, EDecl i@InstDecl{}) = ((pkg, mod), (Nothing, hseToItem_ i))+        f (pkg, mod) (t, EDecl x) = ((pkg, mod), (Just t{targetPackage=pkg, targetModule=mod, targetURL=url}, hseToItem_ x))+            where url = targetURL t `orIfNull` case x of+                            _ | [n] <- declNames x -> hackageDeclURL (isTypeSig x) n+                              | otherwise -> ""++        isGhc = "~ghc" `isInfixOf` packageUrl || "/" `isSuffixOf` packageUrl++        hseToItem_ x = hseToItem x `orIfNull` error ("hseToItem failed, " ++ pretty x)+        infix 1 `orIfNull`+        orIfNull x y = if null x then y else x++renderPackage :: PkgName -> [Char]+renderPackage x = "<b>package</b> <span class=name><s0>" ++ escapeHTML (unPackageName x) ++ "</s0></span>"++renderModule :: Str -> [Char]+renderModule (breakEnd (== '.') . strUnpack -> (pre,post)) = "<b>module</b> " ++ escapeHTML pre ++ "<span class=name><s0>" ++ escapeHTML post ++ "</s0></span>"+++renderItem :: Entry -> String+renderItem = keyword . focus+    where+        keyword x | Just b <- stripPrefix "type family " x = "<b>type family</b> " ++ b+                  | (a,b) <- word1 x, a `elem` kws = "<b>" ++ a ++ "</b> " ++ b+                  | otherwise = x+            where kws = words "class data type newtype"++        name x = "<span class=name>" ++ x ++ "</span>" :: String++        focus (EModule x) = renderModule x+        focus (EPackage x) = renderPackage x+        focus (EDecl x) | [now] <- declNames x, (pre,stripPrefix now -> Just post) <- breakOn now $ pretty x =+            if "(" `isSuffixOf` pre && ")" `isPrefixOf` post then+                init (escapeHTML pre) ++ name ("(" ++ highlight now ++ ")") ++ escapeHTML (tailErr post)+            else+                escapeHTML pre ++ name (highlight now) ++ escapeHTML post+        focus (EDecl x) = pretty x++        highlight :: String -> String+        highlight x = "<s0>" ++ escapeHTML x ++ "</s0>"+++parseLine :: String -> Either String [Entry]+parseLine x@('@':str) = case a of+        "package" | [b] <- words b, b /= "" -> Right [EPackage $ mkPackageName b]+        "version" -> Right []+        _ -> Left $ "unknown attribute: " ++ x+    where (a,b) = word1 str+parseLine (stripPrefix "module " -> Just x) = Right [EModule $ strPack x]+parseLine x | Just x <- readItem x = case x of+    TypeSig a bs c -> Right [EDecl (TypeSig a [b] c) | b <- bs]+    x -> Right [EDecl x]+parseLine x = Left $ "failed to parse: " ++ x+++fixLine :: String -> String+fixLine (stripPrefix "instance [incoherent] " -> Just x) = fixLine $ "instance " ++ x+fixLine (stripPrefix "instance [overlap ok] " -> Just x) = fixLine $ "instance " ++ x+fixLine (stripPrefix "instance [overlapping] " -> Just x) = fixLine $ "instance " ++ x+fixLine (stripPrefix "instance [safe] " -> Just x) = fixLine $ "instance " ++ x+fixLine (stripPrefix "(#) " -> Just x) = "( # ) " ++ x+fixLine ('[':x:xs) | isAlpha x || x `elem` ("_(" :: String), (a,']':b) <- break (== ']') xs = x : a ++ b+fixLine ('[':':':xs) | (a,']':b) <- break (== ']') xs = "(:" ++ a ++ ")" ++ b+-- Record field accessor can start from '$', such as ($*) in algebra-4.3.1+fixLine ('[':'$':xs) | (a,']':b) <- break (== ']') xs = "($" ++ a ++ ")" ++ b+-- Record field accessor can start from '>', such as (>>-) in turtle-1.6.2+fixLine ('[':'>':xs) | (a,']':b) <- break (== ']') xs = "(>" ++ a ++ ")" ++ b+fixLine x | "class " `isPrefixOf` x = fst $ breakOn " where " x+fixLine x = x+++readItem :: String -> Maybe (Decl ())+readItem x -- newtype+    | Just x <- stripPrefix "newtype " x+    , ParseOk (DataDecl an _ b c d e) <- fmap unGADT $ myParseDecl $ "data " ++ x+    = Just $ DataDecl an (NewType ()) b c d e+readItem x@(x0 : _) -- constructors+    | isUpper x0 || x0 == '('+    , ParseOk (GDataDecl _ _ _ _ _ [GadtDecl s name _ _ _ ty] _) <- myParseDecl $ "data Data where " ++ x+    , let f (TyBang _ _ _ (TyParen _ x@TyApp{})) = x+          f (TyParen _ x@TyApp{}) = x+          f (TyBang _ _ _ x) = x+          f x = x+    = Just $ TypeSig s [name] $ applyFun1 $ map f $ unapplyFun ty+readItem x | ParseOk y <- myParseDecl x = Just $ unGADT y+readItem _ = Nothing++unGADT :: Decl l -> Decl l+unGADT (GDataDecl a b c d _  [] e) = DataDecl a b c d [] e+unGADT x = x++prettyItem :: Entry -> String+prettyItem (EPackage x) = "package " ++ unPackageName x+prettyItem (EModule x) = "module " ++ strUnpack x+prettyItem (EDecl x) = pretty x+++input_haddock_test :: IO ()+input_haddock_test = testing "Input.Haddock.parseLine" $ do+    let a === b | fmap (map prettyItem) (parseLine a) == Right [b] = putChar '.'+                | otherwise = errorIO $ show (a,b,parseLine a, fmap (map prettyItem) $ parseLine a)+    let test a = a === a+    test "type FilePath = [Char]"+    test "data Maybe a"+    test "Nothing :: Maybe a"+    test "Just :: a -> Maybe a"+    test "newtype Identity a"+    test "foo :: Int# -> b"+    test "(,,) :: a -> b -> c -> (a, b, c)"+    "data (,,) a b" === "data Tuple3 a b" -- when ghc-lib-parser >= 9.8+    test "reverse :: [a] -> [a]"+    -- Parallel Haskell has never been implemented+    -- test "reverse :: [:a:] -> [:a:]"+    test "module Foo.Bar"+    test "data Char"+    "data Char :: *" === "data Char"+    "newtype ModuleName :: *" === "newtype ModuleName"+    "Progress :: !(Maybe String) -> {-# UNPACK #-} !Int -> !(Int -> Bool) -> Progress" ===+        "Progress :: Maybe String -> Int -> (Int -> Bool) -> Progress"+    test "quotRemInt# :: Int# -> Int# -> (# Int#, Int# #)"+    test "( # ) :: Int"+    test "pattern MyPattern :: ()"+    test "degrees :: Floating x => Radians x -> Degrees x"+    test "class Angle a"+    test "instance Eq x => Eq (Degrees x)"+    test "instance Angle Degrees"+    test "type Queue a = Deque Nonthreadsafe Nonthreadsafe SingleEnd SingleEnd Grow Safe a"+    test "class DequeClass d => PopL d"+    test "tests_fifo :: DequeClass d => (forall elt . IO (d elt)) -> Test"+    test "class ParUnsafe iv p | p -> iv"+    test "(##) :: Diagram -> Diagram -> Diagram"+    test "instance LayoutClass Positioned []"+    test "data Ord a => Range a"+    test "aPair :: Proxy (,)"+    test "aTriple :: Proxy (,,)"+    test "qop :: (Ord a, Show qtyp, Show (QFlipTyp qtyp), QFlipTyp (QFlipTyp qtyp) ~ qtyp) => Set (QueryRep QAtomTyp a) -> Set (QueryRep (QFlipTyp qtyp) a) -> QueryRep qtyp a"+    test "reorient :: (Unbox a) => Bernsteinp Int a -> Bernsteinp Int a"+    "type family PrimM a :: * -> *;" === "type family PrimM a :: * -> *"+    test "HSNil :: HSet '[]"+    "HSCons :: !elem -> HSet elems -> HSet (elem : elems)" === "HSCons :: elem -> HSet elems -> HSet (elem : elems)"+    test "instance Data.HSet.Reverse.HReverse '[e] els1 els2 => Data.HSet.Reverse.HReverse '[] (e : els1) els2"+    test "instance Data.HSet.Remove.HRemove (e : els) els 'TypeFun.Data.Peano.Z"+    test "Free :: (forall m . Monad m => Effects effects m -> m a) -> Free effects a"+    test "infixl 3 <||"+    test "instance Data.String.IsString t => Data.String.IsString (t Yi.MiniBuffer.::: doc)"+    test "runValueExpression :: (Functor f) => Expression a ((->) b) f r -> f ((a -> b) -> r)"+    test "HCons :: (x :: *) -> HList xs -> HList (x : xs)"+    test "instance forall k (key :: k) . Data.Traversable.Traversable (Data.ComposableAssociation.Association key)"+    test "ReflH :: forall (k :: *) (t :: k) . HetEq t t"+    test "egcd :: (PID d, (Euclidean d)) => d -> d -> (d, d, d)"+    test "proc :: FilePath -> [String] -> CreateProcess"+    test "unitTests :: Proxy '()"+    test "type OneToFour = '[1, 2, 3, 4]"+    test "data family Prio pol item :: *"+    test "set :: (Monad m, ToByteString a) => Key -> a -> Opts \"SET\" -> Redis m Bool"+    test "by :: ByteString -> Opts \"SORT\""+    test "infixr 9 :+:"+    test "instance forall k1 k2 (expectation1 :: k2) (expectation2 :: k1) . (Test.TypeSpec.Core.PrettyTypeSpec expectation1, Test.TypeSpec.Core.PrettyTypeSpec expectation2) => Test.TypeSpec.Core.PrettyTypeSpec '(expectation1, expectation2)"+    test "SomeFoo :: Foo a => m a -> SomeFoo m"+    test "(@~?) :: (HasCallStack, Ord a, Num a, Show a, ?epsilon :: a) => a -> a -> Assertion"+    test "data Data where { Idx :: {idxChildren :: Index key (Node height key val)} -> Node ('S height) key val}"+    test "UnexpectedResponse :: forall k a b . () => Host -> Response k a b -> ProtocolError"+    test "(.) :: Category k cat => forall (b :: k) (c :: k) (a :: k) . cat b c -> cat a b -> cat a c"+    test "infixl 3 `And`"+    test "infix 1 `shouldBe`"+    test "pattern The :: The d a => a -> d"+    test "Html :: Element \"html\" '[] (Elements [\"head\", \"body\"]) (ManifestA & '[])"+    test "instance forall k1 v1 (pk :: k1 -> GHC.Types.Constraint) (k2 :: k1) (pv :: v1 -> GHC.Types.Constraint) (v2 :: v1) . (pk k2, pv v2) => Type.Membership.KeyTargetAre pk pv (k2 'Type.Membership.Internal.:> v2)"+    -- The following no longer parses since GHC 9.14 (which is the correct behaviour)+    -- test "crDoubleBuffer :: CompactorReturn s -> {-# UNPACK #-} !DoubleBuffer s"+    test "expectationFailure :: (?callStack :: CallStack) => String -> Expectation"+    test "type family MapTyCon t xs = r | r -> xs"+    test "pattern Id :: CRCategory k => (β ~ α, Object k α) => k α β"+    test "pattern Stream :: () => () => Repetition"+    test "In# :: (# #) -> In (a :: Effects) (b :: Effects)"+    test "anyAsciiDecimalWord# :: Addr# -> Addr# -> (# (# #) | (# Word#, Addr# #) #)"+    test "class SymbolToField (sym :: Symbol) rec typ | sym rec -> typ"+    test "closestPairDist_spec :: _ => ([r] -> r) -> (r -> t) -> [b] -> Property"+    -- Cannot faithfully represent ConstraintKind with ImplicitParams in HSE+    -- test "type HasCallStack = ?callStack :: CallStack"+    -- Cannot faithfully represent @r in HSE+    -- test "Maybe# :: forall (r :: RuntimeRep) (a :: TYPE r). (# (# #) | a #) -> Maybe# @r a"+    -- Cannot faithfully represent visible binders in HSE+    -- test "data NDFamily_ :: forall (name :: Name) -> forall (ks :: Params name). ParamsProxy name ks -> Res name ks Any :~: r -> Args name ks -> Exp r"+    -- Cannot faithfully represent standalone kind signatures in HSE+    -- test "type MinBound :: a;"
+ src/Input/Item.hs view
@@ -0,0 +1,266 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, DeriveFunctor, ViewPatterns #-}+{-# LANGUAGE RecordWildCards, OverloadedStrings, PatternGuards, ScopedTypeVariables #-}++-- | Types used to generate the input.+module Input.Item(+    Sig(..), Ctx(..), Ty(..), prettySig,+    Item(..), itemName, highlightItem,+    Target(..), targetExpandURL, TargetId(..),+    splitIPackage, splitIModule,+    hseToSig, hseToItem, item_test,+    unHTMLTarget+    ) where++import Numeric+import Control.Applicative+import Data.Tuple.Extra+import Language.Haskell.Exts+import Data.Char+import Data.List.Extra+import Data.Maybe+import Data.Ix+import Data.Binary+import Foreign.Storable+import Control.DeepSeq+import Data.Data+import General.Util+import General.Str+import General.IString+import Prelude+import qualified Data.Aeson as J+import Data.Aeson.Types+import Test.QuickCheck+import Distribution.Types.PackageName (unPackageName, mkPackageName)+import Query++---------------------------------------------------------------------+-- TYPES++data Sig n = Sig {sigCtx :: [Ctx n], sigTy :: [Ty n]} deriving (Show,Eq,Ord,Typeable,Data,Functor) -- list of -> types+data Ctx n = Ctx n n deriving (Show,Eq,Ord,Typeable,Data,Functor) -- context, second will usually be a free variable+data Ty n = TCon n [Ty n] | TVar n [Ty n] deriving (Show,Eq,Ord,Typeable,Data,Functor) -- type application, vectorised, all symbols may occur at multiple kinds++instance NFData n => NFData (Sig n) where rnf (Sig x y) = rnf x `seq` rnf y+instance NFData n => NFData (Ctx n) where rnf (Ctx x y) = rnf x `seq` rnf y+instance NFData n => NFData (Ty  n) where+    rnf (TCon x y) = rnf x `seq` rnf y+    rnf (TVar x y) = rnf x `seq` rnf y++instance Binary n => Binary (Sig n) where+    put (Sig a b) = put a >> put b+    get = liftA2 Sig get get++instance Binary n => Binary (Ctx n) where+    put (Ctx a b) = put a >> put b+    get = liftA2 Ctx get get++instance Binary n => Binary (Ty n) where+    put (TCon x y) = put (0 :: Word8) >> put x >> put y+    put (TVar x y) = put (1 :: Word8) >> put x >> put y+    get = do i :: Word8 <- get; liftA2 (case i of 0 -> TCon; 1 -> TVar) get get++prettySig :: Sig String -> String+prettySig Sig{..} =+        (if length ctx > 1 then "(" ++ ctx ++ ") => "+         else if null ctx then "" else ctx ++ " => ") +++        intercalate " -> " (map f sigTy)+    where+        ctx = intercalate ", " [a ++ " " ++ b | Ctx a b <- sigCtx]++        f (TVar x xs) = f $ TCon x xs+        f (TCon x []) = x+        f (TCon x xs) = "(" ++ unwords (x : map f xs) ++ ")"+++---------------------------------------------------------------------+-- ITEMS++data Item+    = IPackage PkgName+    | IModule ModName+    | IName Str+    | ISignature (Sig IString)+    | IAlias Str [IString] (Sig IString)+    | IInstance (Sig IString)+      deriving (Show,Eq,Ord,Typeable,Data)++instance NFData Item where+    rnf (IPackage x) = rnf x+    rnf (IModule x) = rnf x+    rnf (IName x) = x `seq` ()+    rnf (ISignature x) = rnf x+    rnf (IAlias a b c) = rnf (a,b,c)+    rnf (IInstance a) = rnf a++itemName :: Item -> Maybe Str+itemName (IPackage x) = Just $ strPack $ unPackageName x+itemName (IModule x) = Just x+itemName (IName x) = Just x+itemName (ISignature _) = Nothing+itemName (IAlias x _ _) = Just x+itemName (IInstance _) = Nothing+++---------------------------------------------------------------------+-- DATABASE++newtype TargetId = TargetId Word32 deriving (Eq,Ord,Storable,NFData,Ix,Typeable)++instance Show TargetId where+    show (TargetId x) = showHex x ""++-- | A location of documentation.+data Target = Target+    {targetURL :: URL -- ^ URL where this thing is located+    ,targetPackage :: Maybe (String, URL) -- ^ Name and URL of the package it is in (Nothing if it is a package)+    ,targetModule :: Maybe (String, URL) -- ^ Name and URL of the module it is in (Nothing if it is a package or module)+    ,targetType :: String -- ^ One of package, module or empty string+    ,targetItem :: String -- ^ HTML span of the item, using @\<s0\>@ for the name and @\<s1\>@ onwards for arguments+    ,targetDocs :: String -- ^ HTML documentation to show, a sequence of block level elements+    } deriving (Show,Eq,Ord)++instance NFData Target where+    rnf (Target a b c d e f) = rnf a `seq` rnf b `seq` rnf c `seq` rnf d `seq` rnf e `seq` rnf f++instance ToJSON Target where+    toJSON (Target a b c d e f) = object [+      ("url", toJSON a),+      ("package", maybeNamedURL b),+      ("module", maybeNamedURL c),+      ("type", toJSON d),+      ("item", toJSON e),+      ("docs", toJSON f)+      ]+      where+        maybeNamedURL m = maybe emptyObject namedURL m+        namedURL (name, url) = object [("name", toJSON name), ("url", toJSON url)]++instance FromJSON Target where+  parseJSON = withObject "Target" $ \o ->+    Target <$> o .: "url"+           <*> o `namedUrl` "package"+           <*> o `namedUrl` "module"+           <*> o .: "type"+           <*> o .: "item"+           <*> o .: "docs"+    where namedUrl o' n = do+             mObj <- o' .: n+             if null mObj then pure Nothing+                        else do+                           pkName <- mObj .: "name"+                           pkUrl  <- mObj .: "url"+                           pure $ Just (pkName, pkUrl)++instance Arbitrary Target where+  arbitrary = Target <$> a+                     <*> mNurl+                     <*> mNurl+                     <*> a+                     <*> a+                     <*> a+    where a = arbitrary+          mNurl = do+            oneof [pure Nothing+                 , Just <$> liftA2 (,) a a]++targetExpandURL :: Target -> Target+targetExpandURL t@Target{..} = t{targetURL = url, targetModule = second (const mod) <$> targetModule}+    where+        pkg = maybe "" snd targetPackage+        mod = maybe pkg (plus pkg . snd) targetModule+        url = plus mod targetURL++        plus a b | b == "" = ""+                 | ':':_ <- dropWhile isAsciiLower b = b -- match http: etc+                 | otherwise = a ++ b++unHTMLTarget :: Target -> Target+unHTMLTarget t@Target {..} = t{targetItem=unHTML targetItem, targetDocs=unHTML targetDocs}++splitIPackage :: [(a, Item)] -> [(PkgName, [(a, Item)])]+splitIPackage = splitUsing (mkPackageName "") $ \x -> case snd x of+    IPackage x -> Just x+    _ -> Nothing++splitIModule :: [(a, Item)] -> [(Str, [(a, Item)])]+splitIModule = splitUsing mempty $ \x -> case snd x of+    IModule x -> Just x+    _ -> Nothing++splitUsing :: b -> (a -> Maybe b) -> [a] -> [(b, [a])]+splitUsing def f = repeatedly $ \(x:xs) ->+    let (a,b) = break (isJust . f) xs+    in ((fromMaybe def $ f x, x:a), b)++item_test :: IO ()+item_test = testing "Input.Item.Target JSON (encode . decode = id) " $ do+  quickCheck $ \(t :: Target) -> case J.eitherDecode $ J.encode t of+    (Left  e ) -> False+    (Right t') -> t == t'++highlightItem:: Monoid m => (String -> m) -> (String -> m) -> (String -> m) -> (String -> m) -> [Query] -> String -> m+highlightItem plain safe dull bold qs x+    | Just (pre,x) <- stripInfix "<s0>" x, Just (name,post) <- stripInfix "</s0>" x+        = safe pre <> highlight (unescapeHTML name) <> safe post+    | otherwise = plain x+    where+        highlight x = mconcatMap (\xs@((b,_):_) -> let s = map snd xs in if b then bold s else dull s) $+                    groupOn fst $ zip (findQueries x) x+            where+                -- generates a bool mask, which is only true for charachters that compose given queries+                -- e.g. [ "query" "ya" ] -> [ "AqUeRyAA" ] -> 01111110+                findQueries :: String -> [Bool]+                findQueries (x:xs) | m > 0 = replicate m True ++ drop (m - 1) (findQueries xs)+                    where m = maximum $ 0 : [length y | QueryName y <- qs, lower y `isPrefixOf` lower (x:xs)]+                findQueries (x:xs) = False : findQueries xs+                findQueries [] = []++---------------------------------------------------------------------+-- HSE CONVERSION++hseToSig :: Type a -> Sig String+hseToSig = tyForall+    where+        -- forall at the top is different+        tyForall (TyParen _ x) = tyForall x+        tyForall (TyForall _ _ c t) | Sig cs ts <- tyForall t =+            Sig (maybe [] (concatMap ctx . fromContext) c ++ cs) ts+        tyForall x = Sig [] $ tyFun x++        tyFun (TyParen _ x) = tyFun x+        tyFun (TyFun _ a b) = ty a : tyFun b+        tyFun x = [ty x]++        ty (TyForall _ _ _ x) = TCon "\\/" [ty x]+        ty x@TyFun{} = TCon "->" $ tyFun x+        ty (TyTuple an box ts) = TCon (fromQName $ Special an $ TupleCon an box $ length ts - 1) (map ty ts)+        ty (TyList _ x) = TCon "[]" [ty x]+        ty (TyParArray _ x) = TCon "[::]" [ty x]+        ty (TyApp _ x y) = case ty x of+            TCon a b -> TCon a (b ++ [ty y])+            TVar a b -> TVar a (b ++ [ty y])+        ty (TyVar _ x) = TVar (fromName x) []+        ty (TyCon _ x) = TCon (fromQName x) []+        ty (TyInfix an a (UnpromotedName _ b) c) = ty $ let ap = TyApp an in TyCon an b `ap` a `ap` c+        ty (TyKind _ x _) = ty x+        ty (TyBang _ _ _ x) = ty x+        ty (TyParen _ x) = ty x+        ty _ = TVar "_" []++        ctx (ParenA _ x) = ctx x+        ctx (TypeA _ x)  = ctxTy x+        ctx _ = []++        ctxTy (TyInfix an a (UnpromotedName _ con) b) = ctxTy $ TyApp an (TyApp an (TyCon an con) a) b+        ctxTy (fromTyApps -> TyCon _ con:TyVar _ var:_) = [Ctx (fromQName con) (fromName var)]+        ctxTy _ = []++        fromTyApps (TyApp _ x y) = fromTyApps x ++ [y]+        fromTyApps x = [x]+++hseToItem :: Decl a -> [Item]+hseToItem (TypeSig _ names ty) = ISignature (toIString . strPack <$> hseToSig ty) : map (IName . strPack . fromName) names+hseToItem (TypeDecl _ (fromDeclHead -> (name, bind)) rhs) = [IAlias (strPack $ fromName name) (map (toIString . strPack . fromName . fromTyVarBind) bind) (toIString . strPack <$> hseToSig rhs)]+hseToItem (InstDecl an _ (fromIParen -> IRule _ _ ctx (fromInstHead -> (name, args))) _) = [IInstance $ fmap (toIString . strPack) $ hseToSig $ TyForall an Nothing ctx $ applyType (TyCon an name) args]+hseToItem x = map (IName . strPack) $ declNames x
+ src/Input/ParseDecl.hs view
@@ -0,0 +1,609 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -Wno-missing-signatures -Wno-missing-pattern-synonym-signatures #-}++module Input.ParseDecl (myParseDecl) where++import Prelude hiding (Foldable(..))+import Data.Char (isAlphaNum, isUpper)+import Data.Foldable (Foldable(..))+import Data.List.Extra (dropEnd1, drop1, enumerate, stripPrefix, unsnoc, isInfixOf)+import Data.List.NonEmpty qualified as NE (toList)+import Data.Maybe (isNothing)+import GHC.Data.EnumSet qualified as EnumSet+import GHC.Data.FastString (unpackFS)+import GHC.Data.StringBuffer (stringToStringBuffer)+import GHC.Hs+import GHC.LanguageExtensions.Type (Extension (..))+import GHC.Parser (parseDeclaration)+import GHC.Parser.Lexer (P (..), ParseResult (..), initParserState, mkParserOpts)+import GHC.Types.Fixity (Fixity (..), FixityDirection (..))+import GHC.Types.Name (nameOccName, tvName)+import GHC.Types.Name.Occurrence (OccName (..), occNameString)+import GHC.Types.Name.Reader (RdrName (..), rdrNameOcc, rdrNameSpace)+import GHC.Types.SourceText (SourceText (..))+import GHC.Types.SrcLoc (GenLocated (..), mkRealSrcLoc, unLoc)+import GHC.Unit (GenModule (..))+import GHC.Utils.Error+import GHC.Utils.Outputable (Outputable (..), defaultSDocContext, runSDoc)+import Language.Haskell.Exts qualified as HSE+import Text.Read (readMaybe)++#if !MIN_VERSION_ghc_lib_parser(9,12,0)+pattern HsBang x y <- HsSrcBang _ x y+#endif++#if MIN_VERSION_ghc_lib_parser(9,12,0)+pattern MyFixity x y <- Fixity x y+#else+pattern MyFixity x y <- Fixity _ x y+#endif++#if MIN_VERSION_ghc_lib_parser(9,10,0)+pattern MyPrefixConGADT x <- PrefixConGADT _ x+pattern MyRecConGADT x <- RecConGADT _ x+#else+pattern MyPrefixConGADT x <- PrefixConGADT x+pattern MyRecConGADT x <- RecConGADT x _+#endif++#if !MIN_VERSION_ghc_lib_parser(9,14,0)+#define con_outer_bndrs con_bndrs+#endif++myParseDecl :: String -> HSE.ParseResult (HSE.Decl ())+myParseDecl str = case runGhcLibParser str of+    POk _state x -> case hsDeclToDecl (unLoc x) of+        Nothing -> HSE.ParseFailed HSE.noLoc str+        Just res -> HSE.ParseOk res+    PFailed _state -> HSE.ParseFailed HSE.noLoc str++hsDeclToDecl :: HsDecl GhcPs -> Maybe (HSE.Decl ())+hsDeclToDecl (TyClD _ (SynDecl{tcdLName, tcdTyVars = HsQTvs{hsq_explicit}, tcdRhs})) =+    Just $+        HSE.TypeDecl+            ()+            ( foldl'+                (\acc (L _ tv) -> HSE.DHApp () acc (hsTyVarBndrToTyVarBind tv))+                (HSE.DHead () $ rdrNameToName $ unLoc tcdLName)+                hsq_explicit+            )+            (hsTypeToType $ unLoc tcdRhs)+hsDeclToDecl (TyClD _ (GHC.Hs.DataDecl{tcdLName, tcdTyVars = HsQTvs{hsq_explicit}, tcdDataDefn = HsDataDefn{dd_cons = DataTypeCons _ [], dd_ctxt, dd_kindSig = Nothing}})) =+    Just $+        HSE.DataDecl+            ()+            (HSE.DataType ())+            (fmap (hsTypesToContext . unLoc) dd_ctxt)+            ( foldl'+                (\acc (L _ tv) -> HSE.DHApp () acc (hsTyVarBndrToTyVarBind tv))+                (HSE.DHead () $ rdrNameToName $ unLoc tcdLName)+                hsq_explicit+            )+            []+            []+hsDeclToDecl (TyClD _ (GHC.Hs.DataDecl{tcdLName, tcdTyVars = HsQTvs{hsq_explicit}, tcdDataDefn = HsDataDefn{dd_cons = DataTypeCons _ [], dd_kindSig = Just kind}})) =+    Just $+        HSE.GDataDecl+            ()+            (HSE.DataType ())+            Nothing+            ( foldl'+                (\acc (L _ tv) -> HSE.DHApp () acc (hsTyVarBndrToTyVarBind tv))+                (HSE.DHead () $ rdrNameToName $ unLoc tcdLName)+                hsq_explicit+            )+            (Just $ hsTypeToType $ unLoc kind)+            []+            []+hsDeclToDecl (TyClD _ (GHC.Hs.DataDecl{tcdLName, tcdTyVars = HsQTvs{hsq_explicit}, tcdDataDefn = HsDataDefn{dd_cons = DataTypeCons _ [L _ (ConDeclGADT{con_names, con_outer_bndrs, con_g_args = MyPrefixConGADT args, con_res_ty, con_mb_cxt})]}})) =+    Just $+        HSE.GDataDecl+            ()+            (HSE.DataType ())+            Nothing+            ( foldl'+                (\acc (L _ tv) -> HSE.DHApp () acc (hsTyVarBndrToTyVarBind tv))+                (HSE.DHead () $ rdrNameToName $ unLoc tcdLName)+                hsq_explicit+            )+            Nothing+            ( map+                ( \con_name ->+                    HSE.GadtDecl+                        ()+                        (rdrNameToName $ unLoc con_name)+                        Nothing+                        Nothing+                        Nothing+                        ( maybe id (\bs -> applyTyForall (Just bs) Nothing) (hsOuterTyVarBndrsToFoo $ unLoc con_outer_bndrs) $+                            maybe id (applyTyForall Nothing . Just . hsTypesToContext . unLoc) con_mb_cxt $+                                foldr+#if MIN_VERSION_ghc_lib_parser(9,14,0)+                                    (\CDF{cdf_type} -> HSE.TyFun () (hsTypeToType $ unLoc cdf_type))+#else+                                    (\(HsScaled _ a) -> HSE.TyFun () (hsTypeToType $ unLoc a))+#endif+                                    (hsTypeToType $ unLoc con_res_ty)+                                    args+                        )+                )+                (NE.toList con_names)+            )+            []+hsDeclToDecl (TyClD _ (GHC.Hs.DataDecl{tcdLName, tcdTyVars = HsQTvs{hsq_explicit}, tcdDataDefn = HsDataDefn{dd_cons = DataTypeCons _ [L _ (ConDeclGADT{con_names, con_outer_bndrs, con_g_args = MyRecConGADT (L _ args), con_res_ty, con_mb_cxt})]}})) =+    Just $+        HSE.GDataDecl+            ()+            (HSE.DataType ())+            Nothing+            ( foldl'+                (\acc (L _ tv) -> HSE.DHApp () acc (hsTyVarBndrToTyVarBind tv))+                (HSE.DHead () $ rdrNameToName $ unLoc tcdLName)+                hsq_explicit+            )+            Nothing+            ( map+                ( \con_name ->+                    HSE.GadtDecl+                        ()+                        (rdrNameToName $ unLoc con_name)+                        Nothing+                        Nothing+                        (Just $ map (conDeclFieldToFieldDecl . unLoc) args)+                        ( maybe id (HSE.TyForall () Nothing . Just . hsTypesToContext . unLoc) con_mb_cxt $+                            maybe id (\bs -> HSE.TyForall () (Just bs) Nothing) (hsOuterTyVarBndrsToFoo $ unLoc con_outer_bndrs) $+                                hsTypeToType $+                                    unLoc con_res_ty+                        )+                )+                (NE.toList con_names)+            )+            []+hsDeclToDecl (TyClD _ (FamDecl{tcdFam = FamilyDecl{fdLName, fdInfo = DataFamily, fdTyVars = HsQTvs{hsq_explicit}, fdResultSig}})) =+    Just $+        HSE.DataFamDecl+            ()+            Nothing+            ( foldl'+                (\acc (L _ tv) -> HSE.DHApp () acc (hsTyVarBndrToTyVarBind tv))+                (HSE.DHead () $ rdrNameToName $ unLoc fdLName)+                hsq_explicit+            )+            (familyResultSigToResultSig $ unLoc fdResultSig)+hsDeclToDecl (TyClD _ (FamDecl{tcdFam = FamilyDecl{fdLName, fdTyVars = HsQTvs{hsq_explicit}, fdResultSig, fdInjectivityAnn}})) =+    Just $+        HSE.TypeFamDecl+            ()+            ( foldl'+                (\acc (L _ tv) -> HSE.DHApp () acc (hsTyVarBndrToTyVarBind tv))+                (HSE.DHead () $ rdrNameToName $ unLoc fdLName)+                hsq_explicit+            )+            (familyResultSigToResultSig $ unLoc fdResultSig)+            (fmap (injectivityAnnToInjectivityInfo . unLoc) fdInjectivityAnn)+hsDeclToDecl (TyClD _ (GHC.Hs.ClassDecl{tcdCtxt, tcdLName, tcdTyVars = HsQTvs{hsq_explicit}, tcdFDs})) =+    Just $+        HSE.ClassDecl+            ()+            (fmap (hsTypesToContext . unLoc) tcdCtxt)+            ( foldl'+                (\acc (L _ tv) -> HSE.DHApp () acc (hsTyVarBndrToTyVarBind tv))+                (HSE.DHead () $ rdrNameToName $ unLoc tcdLName)+                hsq_explicit+            )+            (map (funDepToFunDep . unLoc) tcdFDs)+            Nothing+hsDeclToDecl (SigD _ (GHC.Hs.TypeSig _ names (HsWC{hswc_body = L _ HsSig{sig_body}}))) =+    Just $+        HSE.TypeSig+            ()+            (map (rdrNameToName . unLoc) names)+            (hsTypeToType $ unLoc sig_body)+hsDeclToDecl (SigD _ (GHC.Hs.PatSynSig _ names (L _ HsSig{sig_body}))) =+    Just $ case hsTypeToType (unLoc sig_body) of+        HSE.TyForall () Nothing (Just ctx1) (HSE.TyForall () Nothing (Just ctx2) ty) ->+            HSE.PatSynSig+                ()+                (map (rdrNameToName . unLoc) names)+                Nothing+                (Just ctx1)+                Nothing+                (Just ctx2)+                ty+        HSE.TyForall () Nothing (Just ctx) ty ->+            HSE.PatSynSig+                ()+                (map (rdrNameToName . unLoc) names)+                Nothing+                (Just ctx)+                Nothing+                Nothing+                ty+        ty ->+            HSE.PatSynSig+                ()+                (map (rdrNameToName . unLoc) names)+                Nothing+                Nothing+                Nothing+                Nothing+                ty+hsDeclToDecl (SigD _ (FixSig _ (FixitySig _ names (MyFixity priority direction)))) =+    Just $+        HSE.InfixDecl+            ()+            (fixityDirectionToAssoc direction)+            (Just priority)+            (map (varOpOrConOp . rdrNameToName . unLoc) names)+hsDeclToDecl (InstD _ (ClsInstD{cid_inst = ClsInstDecl{cid_poly_ty = (L _ HsSig{sig_bndrs, sig_body})}})) =+    Just $ case hsTypeToType (unLoc sig_body) of+        HSE.TyForall () Nothing ctxt body ->+            HSE.InstDecl+                ()+                Nothing+                (HSE.IRule () (hsOuterTyVarBndrsToFoo sig_bndrs) ctxt (typeToInstHead body))+                Nothing+        body ->+            HSE.InstDecl+                ()+                Nothing+                (HSE.IRule () (hsOuterTyVarBndrsToFoo sig_bndrs) Nothing (typeToInstHead body))+                Nothing+hsDeclToDecl _ = Nothing++injectivityAnnToInjectivityInfo :: InjectivityAnn GhcPs -> HSE.InjectivityInfo ()+injectivityAnnToInjectivityInfo = \case+    InjectivityAnn _ lhs rhs ->+        HSE.InjectivityInfo () (rdrNameToName $ unLoc lhs) (map (rdrNameToName . unLoc) rhs)++#if MIN_VERSION_ghc_lib_parser(9,14,0)+conDeclFieldToFieldDecl :: HsConDeclRecField GhcPs -> HSE.FieldDecl ()+conDeclFieldToFieldDecl = \case+    HsConDeclRecField{cdrf_names, cdrf_spec = CDF{cdf_type}} ->+        HSE.FieldDecl+            ()+            (map (fieldOccToName . unLoc) cdrf_names)+            (hsTypeToType $ unLoc cdf_type)+#else+conDeclFieldToFieldDecl :: ConDeclField GhcPs -> HSE.FieldDecl ()+conDeclFieldToFieldDecl = \case+    ConDeclField{cd_fld_names, cd_fld_type} ->+        HSE.FieldDecl+            ()+            (map (fieldOccToName . unLoc) cd_fld_names)+            (hsTypeToType $ unLoc cd_fld_type)+#endif++fieldOccToName :: FieldOcc GhcPs -> HSE.Name ()+fieldOccToName = \case+    FieldOcc{foLabel} -> rdrNameToName $ unLoc foLabel++varOpOrConOp :: HSE.Name () -> HSE.Op ()+varOpOrConOp name = case name of+    HSE.Symbol () (':' : _) -> HSE.ConOp () name+    HSE.Ident () (c : _)+        | isUpper c -> HSE.ConOp () name+        | otherwise -> HSE.VarOp () name+    _ -> HSE.VarOp () name++familyResultSigToResultSig :: FamilyResultSig GhcPs -> Maybe (HSE.ResultSig ())+familyResultSigToResultSig = \case+    NoSig{} -> Nothing+    GHC.Hs.KindSig _ kind ->+        Just $ HSE.KindSig () $ hsTypeToType $ unLoc kind+    GHC.Hs.TyVarSig _ tvb ->+        Just $ HSE.TyVarSig () $ hsTyVarBndrToTyVarBind $ unLoc tvb++hsOuterTyVarBndrsToFoo :: HsOuterSigTyVarBndrs GhcPs -> Maybe [HSE.TyVarBind ()]+hsOuterTyVarBndrsToFoo = \case+    HsOuterImplicit{} -> Nothing+    HsOuterExplicit{hso_bndrs} -> Just $ map (hsTyVarBndrToTyVarBind . unLoc) hso_bndrs++funDepToFunDep :: GHC.Hs.FunDep GhcPs -> HSE.FunDep ()+funDepToFunDep = \case+    GHC.Hs.FunDep _ lhs rhs ->+        HSE.FunDep () (map (rdrNameToName . unLoc) lhs) (map (rdrNameToName . unLoc) rhs)++fixityDirectionToAssoc :: FixityDirection -> HSE.Assoc ()+fixityDirectionToAssoc = \case+    InfixL -> HSE.AssocLeft ()+    InfixR -> HSE.AssocRight ()+    InfixN -> HSE.AssocNone ()++hsTyVarBndrToTyVarBind ::+    HsTyVarBndr a GhcPs ->+    HSE.TyVarBind ()+#if MIN_VERSION_ghc_lib_parser(9,12,0)+hsTyVarBndrToTyVarBind = \case+    HsTvb _ _ (HsBndrVar _ (L _ var)) HsBndrNoKind{} ->+        HSE.UnkindedVar () (rdrNameToName var)+    HsTvb _ _ (HsBndrVar _ (L _ var)) (HsBndrKind _ (L _ kind)) ->+        HSE.KindedVar () (rdrNameToName var) (hsTypeToType kind)+    HsTvb _ _ (HsBndrWildCard _) _ ->+        HSE.UnkindedVar () (HSE.Ident () "_")+#else+hsTyVarBndrToTyVarBind = \case+    UserTyVar _ _ (L _ var) ->+        HSE.UnkindedVar () (rdrNameToName var)+    KindedTyVar _ _ (L _ var) (L _ kind) ->+        HSE.KindedVar () (rdrNameToName var) (hsTypeToType kind)+#endif++occNameToName :: OccName -> HSE.Name ()+occNameToName occ = case occNameString occ of+    xs@(x : _)+        | not (isAlphaNum x) && x /= '(' && x /= '_' -> HSE.Symbol () xs+    xs -> HSE.Ident () xs++rdrNameToName :: RdrName -> HSE.Name ()+rdrNameToName = occNameToName . rdrNameOcc++rdrNameToQName :: RdrName -> HSE.QName ()+rdrNameToQName = \case+    Unqual occName ->+        HSE.UnQual () $ occNameToName occName+    GHC.Types.Name.Reader.Qual modName occName ->+        HSE.Qual+            ()+            (HSE.ModuleName () (moduleNameString modName))+            (occNameToName occName)+    Orig modul occName ->+        HSE.Qual+            ()+            (HSE.ModuleName () (moduleNameString $ moduleName modul))+            (occNameToName occName)+    Exact name ->+        HSE.UnQual () $ occNameToName (nameOccName name)++hsTypeToType :: HsType GhcPs -> HSE.Type ()+hsTypeToType = \case+    HsListTy _ x ->+        HSE.TyList () $ hsTypeToType $ unLoc x+    HsTyVar _ _ (L _ (Exact x))+        | show (runSDoc (ppr x) defaultSDocContext) == "[]" ->+            HSE.TyCon () $ HSE.Special () $ HSE.ListCon ()+        | show (runSDoc (ppr x) defaultSDocContext) == "->" ->+            HSE.TyCon () $ HSE.Special () $ HSE.FunCon ()+        | Just n <- stripPrefix "Tuple" (occNameString (nameOccName x))+        , Just n' <- readMaybe n ->+            HSE.TyCon () $ HSE.Special () $ HSE.TupleCon () HSE.Boxed n'+    HsTyVar _ IsPromoted (L _ x) ->+        HSE.TyPromoted () $ HSE.PromotedCon () True $ rdrNameToQName x+    HsTyVar _ NotPromoted (L _ x) ->+        case rdrNameSpace x of+            ns+                | ns == tvName ->+                    HSE.TyVar () $ rdrNameToName x+            _ -> HSE.TyCon () $ rdrNameToQName x+    HsAppTy _ x y ->+        HSE.TyApp () (hsTypeToType $ unLoc x) (hsTypeToType $ unLoc y)+    HsFunTy _ _ x y ->+        HSE.TyFun () (hsTypeToType $ unLoc x) (hsTypeToType $ unLoc y)+    HsTupleTy _ HsBoxedOrConstraintTuple [] ->+        HSE.TyCon () $ HSE.Special () $ HSE.UnitCon ()+    HsTupleTy _ HsUnboxedTuple [] ->+        HSE.TyCon () $ HSE.Special () $ HSE.UnboxedSingleCon ()+    HsTupleTy _ boxed xs ->+        HSE.TyTuple () (hsTupleSortToBoxed boxed) (map (hsTypeToType . unLoc) xs)+    HsStarTy _ _ ->+        HSE.TyStar ()+#if !MIN_VERSION_ghc_lib_parser(9,14,0)+    HsBangTy _ (HsBang unpackedness strictness) x ->+        applyTyBang+            (srcStrictnessToBangType strictness)+            (srcUnpackednessToUnpackedness unpackedness)+            (hsTypeToType $ unLoc x)+#endif+    HsParTy _ x -> case hsTypeToType (unLoc x) of+        x'@HSE.TyKind{} -> x'+        x' -> HSE.TyParen () x'+    HsQualTy{hst_ctxt, hst_body} ->+        applyTyForall Nothing (Just $ hsTypesToContext $ unLoc hst_ctxt) $+            hsTypeToType $+                unLoc hst_body+    HsForAllTy{hst_tele = HsForAllInvis{hsf_invis_bndrs}, hst_body} ->+        applyTyForall+            (Just $ map (hsTyVarBndrToTyVarBind . unLoc) hsf_invis_bndrs)+            Nothing+            (hsTypeToType $ unLoc hst_body)+    -- TODO FIXME when migrating to ghc-lib-parser completely:+    -- HSE does not support forall with visible binders+    HsForAllTy{hst_tele = HsForAllVis{hsf_vis_bndrs}, hst_body} ->+        applyTyForall+            (Just $ map (hsTyVarBndrToTyVarBind . unLoc) hsf_vis_bndrs)+            Nothing+            (hsTypeToType $ unLoc hst_body)+    HsExplicitListTy _ IsPromoted xs ->+        HSE.TyPromoted () $ HSE.PromotedList () True (map (hsTypeToType . unLoc) xs)+    HsExplicitListTy _ NotPromoted [x] ->+        HSE.TyList () $ hsTypeToType $ unLoc x+    HsExplicitListTy _ NotPromoted xs ->+        HSE.TyPromoted () $ HSE.PromotedList () False (map (hsTypeToType . unLoc) xs)++#if MIN_VERSION_ghc_lib_parser(9,12,0)+    HsExplicitTupleTy _ IsPromoted [] ->+        HSE.TyPromoted () $ HSE.PromotedCon () True $ HSE.Special () $ HSE.UnitCon ()+    HsExplicitTupleTy _ IsPromoted xs ->+        HSE.TyPromoted () $ HSE.PromotedTuple () $ map (hsTypeToType . unLoc) xs+    HsExplicitTupleTy _ NotPromoted xs ->+        HSE.TyTuple () HSE.Boxed (map (hsTypeToType . unLoc) xs)+#else+    HsExplicitTupleTy _ [] ->+        HSE.TyPromoted () $ HSE.PromotedCon () True $ HSE.Special () $ HSE.UnitCon ()+    HsExplicitTupleTy _ xs ->+        HSE.TyPromoted () $ HSE.PromotedTuple () $ map (hsTypeToType . unLoc) xs+#endif++    HsOpTy _ _ x (L _ (Unqual y)) z+        | occNameString y == "~" ->+            HSE.TyEquals () (hsTypeToType $ unLoc x) (hsTypeToType $ unLoc z)+    HsOpTy _ promotion x (L _ (Exact y)) z+        | occNameString (nameOccName y) == ":" ->+            HSE.TyInfix+                ()+                (hsTypeToType $ unLoc x)+                (promotionFlagToMaybePromotedName promotion $ HSE.Special () $ HSE.Cons ())+                (hsTypeToType $ unLoc z)+    HsOpTy _ promotion x y z ->+        HSE.TyInfix+            ()+            (hsTypeToType $ unLoc x)+            (promotionFlagToMaybePromotedName promotion $ rdrNameToQName $ unLoc y)+            (hsTypeToType $ unLoc z)+    HsKindSig _ lhs rhs ->+        HSE.TyKind () (hsTypeToType $ unLoc lhs) (hsTypeToType $ unLoc rhs)+    HsTyLit _ (HsNumTy (SourceText txt) val) ->+        HSE.TyPromoted () $ HSE.PromotedInteger () val (unpackFSOrId txt)+    HsTyLit _ (HsStrTy (SourceText txt) val) ->+        HSE.TyPromoted () $ HSE.PromotedString () (unpackFS val) (drop1 $ dropEnd1 $ unpackFSOrId txt)+    HsSumTy _ xs ->+        HSE.TyUnboxedSum () $ map (hsTypeToType . unLoc) xs+    HsWildCardTy _ ->+        HSE.TyWildCard () Nothing+    -- Everything else cannot be represented in HSE, so replacing with a wildcard+    _ -> HSE.TyWildCard () Nothing++promotionFlagToMaybePromotedName ::+    PromotionFlag -> HSE.QName () -> HSE.MaybePromotedName ()+promotionFlagToMaybePromotedName = \case+    NotPromoted -> HSE.UnpromotedName ()+    IsPromoted -> HSE.PromotedName ()++applyTyForall ::+    Maybe [HSE.TyVarBind ()] -> Maybe (HSE.Context ()) -> HSE.Type () -> HSE.Type ()+applyTyForall mArg1 mArg2 = \case+    HSE.TyForall () Nothing mArg2' ty+        | isNothing mArg2 -> HSE.TyForall () mArg1 mArg2' ty+    ty -> HSE.TyForall () mArg1 mArg2 ty++#if !MIN_VERSION_ghc_lib_parser(9,14,0)+applyTyBang ::+    HSE.BangType () -> HSE.Unpackedness () -> HSE.Type () -> HSE.Type ()+applyTyBang bang unpack = \case+    HSE.TyBang () (HSE.NoStrictAnnot ()) unpack' ty+        | unpack == HSE.NoUnpackPragma () -> HSE.TyBang () bang unpack' ty+    HSE.TyBang () bang' (HSE.NoUnpackPragma ()) ty+        | bang == HSE.NoStrictAnnot () -> HSE.TyBang () bang' unpack ty+    HSE.TyApp () x y -> HSE.TyApp () (applyTyBang bang unpack x) y+    ty -> HSE.TyBang () bang unpack ty++srcStrictnessToBangType :: SrcStrictness -> HSE.BangType ()+srcStrictnessToBangType = \case+    SrcLazy -> HSE.LazyTy ()+    SrcStrict -> HSE.BangedTy ()+    NoSrcStrict -> HSE.NoStrictAnnot ()++srcUnpackednessToUnpackedness :: SrcUnpackedness -> HSE.Unpackedness ()+srcUnpackednessToUnpackedness = \case+    SrcUnpack -> HSE.Unpack ()+    SrcNoUnpack -> HSE.NoUnpack ()+    NoSrcUnpack -> HSE.NoUnpackPragma ()+#endif++typeToInstHead :: HSE.Type () -> HSE.InstHead ()+typeToInstHead = \case+    HSE.TyApp () x y -> HSE.IHApp () (typeToInstHead x) y+    HSE.TyCon () x -> HSE.IHCon () x+    HSE.TyInfix () x (HSE.UnpromotedName () y) z -> HSE.IHApp () (HSE.IHInfix () x y) z+    -- The rest happens only in ghc-prim, which are likely some magical forms.+    -- Let's skip them.+    _ -> HSE.IHCon () $ HSE.Special () $ HSE.UnitCon ()++hsTypesToContext ::+    [GenLocated SrcSpanAnnA (HsType GhcPs)] ->+    HSE.Context ()+hsTypesToContext = \case+    [] -> HSE.CxEmpty ()+    [x] -> HSE.CxSingle () $ hsTypeToAsst $ unLoc x+    xs -> HSE.CxTuple () $ map (hsTypeToAsst . unLoc) xs++hsTypeToAsst :: HsType GhcPs -> HSE.Asst ()+hsTypeToAsst = \case+    HsIParamTy _ name t ->+        HSE.IParam () (hsIPNameToIPName $ unLoc name) (hsTypeToType $ unLoc t)+    HsParTy _ t ->+        HSE.ParenA () $ hsTypeToAsst $ unLoc t+    t -> case hsTypeToType t of+        HSE.TyParen () ty -> HSE.ParenA () $ HSE.TypeA () ty+        ty -> HSE.TypeA () ty++hsIPNameToIPName :: HsIPName -> HSE.IPName ()+hsIPNameToIPName = HSE.IPDup () . unpackFS . hsIPNameFS++hsTupleSortToBoxed :: HsTupleSort -> HSE.Boxed+hsTupleSortToBoxed = \case+    HsUnboxedTuple -> HSE.Unboxed+    HsBoxedOrConstraintTuple -> HSE.Boxed++runGhcLibParser ::+    String ->+    GHC.Parser.Lexer.ParseResult (GenLocated SrcSpanAnnA (HsDecl GhcPs))+runGhcLibParser str+    | Just (str', ';') <- unsnoc str =+        runGhcLibParser str'+runGhcLibParser str = case runGhcLibParserWithExtensions almostAllExtensions str of+    PFailed{}+        | '#' `elem` str -> runGhcLibParserWithExtensions noUnboxed str+        | '*' `elem` str -> runGhcLibParserWithExtensions noStarIsType str+        | "pattern" `isInfixOf` str -> runGhcLibParserWithExtensions noPatternSynonyms str+    res -> res++allExtensions :: EnumSet.EnumSet Extension+allExtensions = EnumSet.fromList enumerate++almostAllExtensions :: EnumSet.EnumSet Extension+almostAllExtensions =+    foldr+        EnumSet.delete+        allExtensions+        [ Arrows -- makes "proc" a keyword+        , RecursiveDo -- makes "mdo" and "rec" keywords+        , StaticPointers -- makes "static" a keyword+        , TransformListComp -- makes "by", "group" and "using" keywords+        ]++noUnboxed :: EnumSet.EnumSet Extension+noUnboxed =+    foldr+        EnumSet.delete+        almostAllExtensions+        [ UnboxedSums+        , UnboxedTuples+        ]++noPatternSynonyms :: EnumSet.EnumSet Extension+noPatternSynonyms = EnumSet.delete PatternSynonyms almostAllExtensions++noStarIsType :: EnumSet.EnumSet Extension+noStarIsType = EnumSet.delete StarIsType almostAllExtensions++runGhcLibParserWithExtensions ::+    EnumSet.EnumSet Extension ->+    String ->+    GHC.Parser.Lexer.ParseResult (GenLocated SrcSpanAnnA (HsDecl GhcPs))+runGhcLibParserWithExtensions extensions str = unP parseDeclaration parseState+  where+#if MIN_VERSION_ghc_lib_parser(9,14,0)+    opts = mkParserOpts extensions emptyDiagOpts False False False False+#else+    opts = mkParserOpts extensions emptyDiagOpts [] False False False False+#endif+    dummyLocation = mkRealSrcLoc mempty 1 1+    buffer = stringToStringBuffer str+    parseState = initParserState opts buffer dummyLocation++#if !MIN_VERSION_ghc_lib_parser(9,8,0)+emptyDiagOpts :: DiagOpts+emptyDiagOpts = DiagOpts mempty mempty False False Nothing defaultSDocContext+#endif++#if MIN_VERSION_ghc_lib_parser(9,8,0)+unpackFSOrId = unpackFS+#else+unpackFSOrId = id+#endif
+ src/Input/Reorder.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE RecordWildCards, OverloadedStrings #-}++module Input.Reorder(reorderItems) where++import Input.Item+import Input.Settings+import Data.List.Extra+import Data.Tuple.Extra+import General.Util+import General.Str+import Distribution.Types.PackageName (mkPackageName, unPackageName)+++pkgGhc :: PkgName+pkgGhc = mkPackageName "ghc"++packageOrderHacks :: (PkgName -> Int) -> PkgName -> Int+-- 'ghc' is the canonical module that both 'ghc-lib-parser' and 'ghc-lib' copy from, so better to pick that+-- even though ghc-lib-* are used more on Stackage (but a lot less on Hackage)+packageOrderHacks f x | x == pkgGhc = min (f x) $ min (f $ mkPackageName "ghc-lib-parser") (f $ mkPackageName "ghc-lib") - 1+packageOrderHacks f x = f x+++-- | Reorder items so the most popular ones are first, using reverse dependencies.+--   Low numbers for the PkgName function mean the package is more popular.+reorderItems :: Settings -> (PkgName -> Int) -> [(a, Item)] -> [(a, Item)]+reorderItems Settings{..} packageOrder xs =+    concatMap snd $ sortOn ((packageOrderHacks packageOrder &&& id) . fst) $ map rebase $ splitIPackage xs+    where+        refunc = map $ second $ \(x:xs) -> x : sortOn (itemName . snd) xs+        rebase (x, xs) = (x, concatMap snd $ sortOn (((negate . f . strUnpack) &&& id) . fst) $ refunc $ splitIModule xs)+            where f = reorderModule (unPackageName x)
+ src/Input/Set.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE PatternGuards, TupleSections #-}++module Input.Set(setStackage, setPlatform, setGHC) where++import Control.Applicative+import Data.List.Extra+import System.IO.Extra+import qualified Data.Set as Set+import Prelude+++-- | Return information about which items are in a particular set.+setStackage :: FilePath -> IO (Set.Set String)+setStackage file = Set.fromList . filter (`notElem` stackOverflow) . f . lines <$> readFile' file+    where+        stackOverflow = [] -- ["telegram-api","pinchot","gogol-dfareporting"] -- see https://github.com/ndmitchell/hoogle/issues/167++        f (x:xs) | Just x <- stripPrefix "constraints:" x =+                    map (fst . word1) $ takeWhile (" " `isPrefixOf`) $ (' ':x) : xs+                 | otherwise = f xs+        f [] = []+++setPlatform :: FilePath -> IO (Set.Set String)+setPlatform file = setPlatformWith file ["incGHCLib","incLib"]++setPlatformWith :: FilePath -> [String] -> IO (Set.Set String)+setPlatformWith file names = do+    src <- lines <$> readFile' file+    pure $ Set.delete "bin-package-db" $+        Set.fromList [read lib | ",":name:lib:_ <- map words src, name `elem` names]++setGHC :: FilePath -> IO (Set.Set String)+setGHC file = setPlatformWith file ["incGHCLib"]
+ src/Input/Settings.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE PackageImports, RecordWildCards, PatternGuards, TemplateHaskell, CPP #-}+++-- | Module for reading settings files.+module Input.Settings(+    Settings(..), loadSettings+    ) where++import Control.Exception (catch, throwIO)+import Data.List.Extra+import Data.Maybe+import "template-haskell" Language.Haskell.TH.Syntax (lift, runIO)+import System.FilePath+import System.IO.Error (isDoesNotExistError)+import System.IO.Extra+import qualified Data.Map.Strict as Map+import Paths_hoogle+++-- | Settings values. Later settings always override earlier settings.+data Setting+    = -- | Given a Cabal tag/author rename it from the LHS to the RHS.+      --   If the RHS is blank, delete the tag.+      RenameTag String String+    | -- | Change the priority of a module. Given package name, module name, new priority.+      --   Use * for wildcard matches. All un-reordered modules are 0+      ReorderModule String String Int+    deriving Read+++data Settings = Settings+    {renameTag :: String -> String -- ^ Rename a cabal tag+    ,reorderModule :: String -> String -> Int+    }+++readFileSettings :: FilePath -> String -> IO [Setting]+readFileSettings file backup = do+    src <- readFileUTF8 file `catch` \e ->+        if isDoesNotExistError e+            then pure backup+            else throwIO e+    pure $ concat $ zipWithFrom f 1 $ map trim $ lines src+    where+        f i s | null s = []+              | "--" `isPrefixOf` s = []+              | [(x,"")] <- reads s = [x]+              | otherwise = error $ file ++ ":" ++ show i ++ ": Failure to parse, got: " ++ s++++-- | Fix bad names in the Cabal file.+loadSettings :: IO Settings+loadSettings = do+    dataDir <- getDataDir+#ifdef PROFILE+    -- profiling and TemplateHaskell don't play well+    let backup = ""+#else+    let backup = $(runIO (readFileUTF8 "misc/settings.txt") >>= lift)+#endif+    src <- readFileSettings (dataDir </> "misc/settings.txt") backup+    pure $ createSettings src++createSettings :: [Setting] -> Settings+createSettings xs = Settings{..}+    where+        renameTag = \x -> fromMaybe x $ f x+            where f = literals [(a,b) | RenameTag a b <- xs]++        reorderModule = \pkg -> case f pkg of+                                    [] -> const 0+                                    xs -> let f = wildcards xs+                                          in \mod -> lastDef 0 (f mod)+            where f = wildcards [(a,(b,c)) | ReorderModule a b c <- xs]+++---------------------------------------------------------------------+-- SPECIAL LOOKUPS++literals :: [(String, a)] -> String -> Maybe a+literals xs = \x -> Map.lookup x mp+    where mp = Map.fromList xs++wildcards :: [(String, a)] -> String -> [a]+wildcards xs x = [b | (a,b) <- xs, matchWildcard a x]++matchWildcard :: String -> String -> Bool+matchWildcard ['*'] ys = True -- special common case+matchWildcard ('*':xs) ys = any (matchWildcard xs) $ tails ys+matchWildcard (x:xs) (y:ys) = x == y && matchWildcard xs ys+matchWildcard [] [] = True+matchWildcard _ _ = False
src/Main.hs view
@@ -1,12 +1,12 @@ -module Main where+module Main(main) where -import CmdLine.All-import Console.All as Console-import Web.All as Web+import System.Environment+import System.IO+import Hoogle   main :: IO () main = do-    q <- cmdLine-    if isWebCmdLine q then Web.action q else Console.action q+    hSetEncoding stdout utf8+    hoogle =<< getArgs
+ src/Output/Items.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE TupleSections, RecordWildCards, ScopedTypeVariables, PatternGuards, DeriveDataTypeable, GADTs #-}++module Output.Items(writeItems, lookupItem, listItems) where++import Control.Monad+import Data.List.Extra+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.ByteString.Lazy.UTF8 as UTF8+import qualified Codec.Compression.GZip as GZip+import General.Str++import Input.Item+import General.Util+import General.Store+import General.Conduit+++data Items a where Items :: Items BS.ByteString deriving Typeable+++outputItem :: Target -> [String]+outputItem Target{..} =+    [if null targetURL then "." else targetURL+    ,maybe "." (joinPair " ") targetPackage+    ,maybe "." (joinPair " ") targetModule+    ,if null targetType then "." else targetType+    ,targetItem] +++    replace [""] ["."] (lines targetDocs)++inputItem :: [String] -> Target+inputItem (url:pkg:modu:typ:self:docs) = targetExpandURL $+    Target (if url == "." then "" else url) (f pkg) (f modu) (if typ == "." then "" else typ) self (unlines $ replace ["."] [""] docs)+    where+        f "." = Nothing+        f x = Just $ word1 x++-- write all the URLs, docs and enough info to pretty print it to a result+-- and replace each with an identifier (index in the space) - big reduction in memory+writeItems :: StoreWrite -> (ConduitM (Maybe Target, item) (Maybe TargetId, item) IO () -> IO a) -> IO a+writeItems store act = act $ do+    void $ (\f -> mapAccumMC f 0) $ \pos (target, item) -> case target of+        Nothing -> pure (pos, (Nothing, item))+        Just target -> do+            let bs = LBS.toStrict $ GZip.compress $ lbstrPack $ unlines $ outputItem target+            liftIO $ do+                storeWritePart store Items $ intToBS $ BS.length bs+                storeWritePart store Items bs+            let pos2 = pos + fromIntegral (intSize + BS.length bs)+            pure (pos2, (Just $ TargetId pos, item))+++listItems :: StoreRead -> [Target]+listItems store = unfoldr f $ storeRead store Items+    where+        f x | BS.null x = Nothing+            | (n,x) <- BS.splitAt intSize x+            , n <- intFromBS n+            , (this,x) <- BS.splitAt n x+            = Just (inputItem $ lines $ UTF8.toString $ GZip.decompress $ LBS.fromChunks [this], x)+++lookupItem :: StoreRead -> (TargetId -> Target)+lookupItem store =+    let x = storeRead store Items+    in \(TargetId i) ->+        let i2 = fromIntegral i+            n = intFromBS $ BS.take intSize $ BS.drop i2 x+        in inputItem $ lines $ UTF8.toString $ GZip.decompress $ LBS.fromChunks $ pure $ BS.take n $ BS.drop (i2 + intSize) x
+ src/Output/Names.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE ViewPatterns, TupleSections, ScopedTypeVariables, DeriveDataTypeable, ForeignFunctionInterface, GADTs #-}++module Output.Names(writeNames, searchNames) where++import Data.List.Extra+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Unsafe as BS+import qualified Data.Vector.Storable as V+import General.Str+import Foreign.Ptr+import Foreign.Marshal+import Foreign.C.String+import Foreign.C.Types+import Control.Exception+import System.IO.Unsafe+import Data.Maybe++import Input.Item+import General.Util+import General.Store++foreign import ccall text_search_bound :: CString -> IO CInt++foreign import ccall text_search :: CString -> Ptr CString -> CInt -> Ptr CInt -> IO CInt+++data NamesSize a where NamesSize :: NamesSize Int deriving Typeable+data NamesItems a where NamesItems :: NamesItems (V.Vector TargetId) deriving Typeable+data NamesText a where NamesText :: NamesText BS.ByteString deriving Typeable++writeNames :: StoreWrite -> [(Maybe TargetId, Item)] -> IO ()+writeNames store xs = do+    let (ids, strs) = unzip [(i, [' ' | isUpper1 name] ++ lower name) | (Just i, x) <- xs, name <- itemNamePart x]+    let b = bstr0Join $ strs ++ ["",""]+    bound <- BS.unsafeUseAsCString b $ \ptr -> text_search_bound ptr+    storeWrite store NamesSize $ fromIntegral bound+    storeWrite store NamesItems $ V.fromList ids+    storeWrite store NamesText b++itemNamePart :: Item -> [String]+itemNamePart (IModule x) = [last $ splitOn "." $ strUnpack x]+itemNamePart x = maybeToList $ strUnpack <$> itemName x++searchNames :: StoreRead -> Bool -> [String] -> [TargetId]+-- very important to not search for [" "] or [] since the output buffer is too small+searchNames store exact (filter (/= "") . map trim -> xs) = unsafePerformIO $ do+    let vs = storeRead store NamesItems+    -- if there are no questions, we will match everything, which exceeds the result buffer+    if null xs then pure $ V.toList vs else do+        let tweak x = bstrPack $ [' ' | isUpper1 x] ++ lower x ++ "\0"+        bracket (mallocArray $ storeRead store NamesSize) free $ \result ->+            BS.unsafeUseAsCString (storeRead store NamesText) $ \haystack ->+                withs (map (BS.unsafeUseAsCString . tweak) xs) $ \needles ->+                    withArray0 nullPtr needles $ \needles -> do+                        found <- c_text_search haystack needles (if exact then 1 else 0) result+                        xs <- peekArray (fromIntegral found) result+                        pure $ map ((vs V.!) . fromIntegral) xs++{-# NOINLINE c_text_search #-} -- for profiling+c_text_search a b c d = text_search a b c d
+ src/Output/Tags.hs view
@@ -0,0 +1,178 @@+{-# LANGUAGE ViewPatterns, TupleSections, ScopedTypeVariables, DeriveDataTypeable, PatternGuards, GADTs #-}++module Output.Tags(writeTags, completionTags, applyTags) where++import Data.Bifunctor+import Data.Function+import Data.List.Extra+import Data.Tuple.Extra+import Data.Maybe+import Foreign.Storable.Tuple()+import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified Data.Vector.Storable as V+import qualified Data.ByteString.Char8 as BS++import Input.Item+import Query+import General.Util+import General.Store+import General.Str+import Distribution.Types.PackageName (unPackageName, mkPackageName)++---------------------------------------------------------------------+-- DATA TYPE++-- matches (a,b) if i >= a && i <= b++data Packages a where Packages :: Packages (BStr0, V.Vector (TargetId, TargetId)) deriving Typeable+    -- list of packages, sorted by popularity, lowercase, interspersed with \0+    -- for each index in PackageNames, the first is the module item, any in the bounds are in that package++data Modules a where Modules :: Modules (BStr0, V.Vector (TargetId, TargetId)) deriving Typeable+    -- list of modules, sorted by popularity, not unique, lowercase, interspersed with \0+    -- for each index in ModuleNames, the first is the module item, any in the bounds are in that module++data Categories a where Categories :: Categories (BStr0, Jagged (TargetId, TargetId)) deriving Typeable+    -- list of categories, sorted by name, interspersed with \0+    -- for each index in CategoryNames, a range of items containing a category, first item is a package++data Completions a where Completions :: Completions BStr0 deriving Typeable+    -- a list of things to complete to, interspersed with \0+++writeTags :: StoreWrite -> (PkgName -> Bool) -> (PkgName -> [(String,String)]) -> [(Maybe TargetId, Item)] -> IO ()+writeTags store keep extra xs = do+    let splitPkg = splitIPackage xs+    let packages = addRange (== mkPackageName "") splitPkg+    storeWrite store Packages (bstr0Join $ map (unPackageName . fst) packages, V.fromList $ map snd packages)++    let categories = map (bimap snd reverse) $ Map.toList $ Map.fromListWith (++)+            [(((weightTag ex, both lower ex), joinPair ":" ex),[rng]) | (p,rng) <- packages, ex <- extra p]+    storeWrite store Categories (bstr0Join $ map fst categories, jaggedFromList $ map snd categories)++    let modules = addRange strNull $ concatMap (splitIModule . snd) splitPkg+    storeWrite store Modules (bstr0Join $ map (lower . strUnpack . fst) modules, V.fromList $ map snd modules)++    storeWrite store Completions $ bstr0Join $+        takeWhile ("set:" `isPrefixOf`) (map fst categories) +++        map ("package:"++) (sortOn lower $ map unPackageName $ nubOrd $ filter keep $ map fst packages) +++        map (joinPair ":") (sortOn (weightTag &&& both lower) $ nubOrd [ex | (p,_) <- packages, keep p, ex <- extra p, fst ex /= "set"])+    where+        addRange :: (str -> Bool) -> [(str, [(Maybe TargetId,a)])] -> [(str, (TargetId, TargetId))]+        addRange isNull xs = [(a, (minimum' is, maximum' is)) | (a,b) <- xs, let is = mapMaybe fst b, not (isNull a), is /= []]++        weightTag ("set",x) = fromMaybe 0.9 $ lookup x [("stackage",0.0),("haskell-platform",0.1)]+        weightTag ("package",x) = 1+        weightTag ("category",x) = 2+        weightTag ("license",x) = 3+        weightTag _ = 4+++---------------------------------------------------------------------+-- SIMPLE SELECTORS++completionTags :: StoreRead -> [String]+completionTags store = map BS.unpack $ bstr0Split $ storeRead store Completions+++---------------------------------------------------------------------+-- DATA TYPE, PARSE, PRINT++data Tag = IsExact | IsPackage | IsModule | EqPackage String | EqModule String | EqCategory String String deriving Eq++parseTag :: String -> String -> Maybe Tag+parseTag k v+    | k ~~ "is" = case () of+        _ | v ~~ "exact" -> Just IsExact+          | v ~~ "package" -> Just IsPackage+          | v ~~ "module" -> Just IsModule+          | otherwise -> Nothing+    | k ~~ "package" = if v == "" then Nothing else Just $ EqPackage v+    | k ~~ "module" = if v == "" then Nothing else Just $ EqModule v+    | v /= "" = Just $ EqCategory k v+    | otherwise = Nothing+    where+        -- make the assumption the first letter always disambiguates+        x ~~ lit = x /= "" && lower x `isPrefixOf` lit++showTag :: Tag -> (String, String)+showTag IsExact = ("is","exact")+showTag IsPackage = ("is","package")+showTag IsModule = ("is","module")+showTag (EqPackage x) = ("package",x)+showTag (EqModule x) = ("module",x)+showTag (EqCategory k v) = (k,v)+++---------------------------------------------------------------------+-- TAG SEMANTICS++-- | Given a tag, find the ranges of identifiers it covers (if it restricts the range)+-- An empty range means an empty result, while a Nothing means a search on the entire range+resolveTag :: StoreRead -> Tag -> (Tag, Maybe [(TargetId,TargetId)])+resolveTag store x = case x of+    IsExact -> (IsExact, Nothing)+    IsPackage -> (IsPackage, Just $ map (dupe . fst) $ V.toList packageIds)+    IsModule -> (IsModule, Just $ map (dupe . fst) $ V.toList moduleIds)+    EqPackage orig@(BS.pack -> val)+        -- look for people who are an exact prefix, sort by remaining length, if there are ties, pick the first one+        | res@(_:_) <- [(BS.length x, (i,x)) | (i,x) <- zipFrom 0 $ bstr0Split packageNames, val `BS.isPrefixOf` x]+            -> let (i,x) = snd $ minimumBy (compare `on` fst) res in (EqPackage $ BS.unpack x, Just [packageIds V.! i])+        | otherwise -> (EqPackage orig , Just [])+    EqModule x -> (EqModule x, Just $ map (moduleIds V.!) $ findIndices (eqModule $ lower x) $ bstr0Split moduleNames)+    EqCategory cat val -> (EqCategory cat val, Just $ concat+        [ V.toList $ jaggedAsk categoryIds i+        | i <- elemIndices (BS.pack (cat ++ ":" ++ val)) $ bstr0Split categoryNames])+    where+        eqModule x | Just x <- stripPrefix "." x, Just x <- stripSuffix "." x = (==) (BS.pack x)+                   | Just x <- stripPrefix "." x = BS.isPrefixOf $ BS.pack x+                   | otherwise = let y = BS.pack x; y2 = BS.pack ('.':x)+                                 in \v -> y `BS.isPrefixOf` v || y2 `BS.isInfixOf` v++        (packageNames, packageIds) = storeRead store Packages+        (categoryNames, categoryIds) = storeRead store Categories+        (moduleNames, moduleIds) = storeRead store Modules+++---------------------------------------------------------------------+-- TAG QUERIES++-- | Given a query produce: (refined query, is:exact, filter, enumeration)+--   You should apply the filter to other peoples results, or if you have nothing else, use the enumeration.+applyTags :: StoreRead -> [Query] -> ([Query], Bool, TargetId -> Bool, [TargetId])+applyTags store qs = (qs2, exact, filt, searchTags store qs)+    where (qs2, exact, filt) = filterTags store qs++filterTags :: StoreRead -> [Query] -> ([Query], Bool, TargetId -> Bool)+filterTags ts qs = (map redo qs, exact, \i -> all ($ i) fs)+    where fs = map (filterTags2 ts . snd) $ groupSort $ map (scopeCategory &&& id) $ filter isQueryScope qs+          exact = Just IsExact `elem` [parseTag a b | QueryScope True a b <- qs]+          redo (QueryScope sense cat val)+              | Just (k,v) <- fmap (showTag . fst . resolveTag ts) $ parseTag cat val = QueryScope sense k v+              | otherwise = QueryNone $ ['-' | not sense] ++ cat ++ ":" ++ val+          redo q = q+++filterTags2 ts qs = \i -> not (negq i) && (noPosRestrict || posq i)+    where (posq,negq) = both inRanges (pos,neg)+          (pos, neg) = both (concatMap snd) $ partition fst xs+          xs = catMaybes restrictions+          noPosRestrict = all pred restrictions+          restrictions = map getRestriction qs+          pred Nothing = True+          pred (Just (sense, _)) = not sense+          getRestriction :: Query -> Maybe (Bool,[(TargetId, TargetId)])+          getRestriction (QueryScope sense cat val) = do+            tag <- parseTag cat val+            ranges <- snd $ resolveTag ts tag+            pure (sense, ranges)+++-- | Given a search which has no type or string in it, run the query on the tag bits.+--   Using for things like IsModule, EqCategory etc.+searchTags :: StoreRead -> [Query] -> [TargetId]+searchTags ts qs+    | x:xs <- [map fst $ maybe [] (fromMaybe [] . snd . resolveTag ts) $ parseTag cat val | QueryScope True cat val <- qs]+    = if null xs then x else filter (`Set.member` foldl1' Set.intersection (map Set.fromList xs)) x+searchTags ts _ = maybe [] (map fst) $ snd $ resolveTag ts IsPackage
+ src/Output/Types.hs view
@@ -0,0 +1,635 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, DeriveFunctor, GADTs,+             GeneralizedNewtypeDeriving, LambdaCase, RecordWildCards,+             ScopedTypeVariables, TupleSections, ViewPatterns #-}++module Output.Types(writeTypes, searchTypes, searchFingerprintsDebug) where++{-+Approach:+Each signature is stored, along with a fingerprint+A quick search finds the most promising 100 fingerprints+A slow search ranks the 100 items, excluding some+-}++import Control.Applicative+import Control.Monad.Extra+import Control.Monad.ST+import Control.Monad.Trans.Class+import Control.Monad.Trans.State.Strict+import Data.Binary hiding (get, put)+import qualified Data.ByteString.Char8 as BS+import Data.Data+import Data.Generics.Uniplate.Data+import Data.List.Extra+import qualified Data.Map.Strict as Map+import Data.Maybe+import qualified Data.Set as Set+import Data.STRef+import Data.Tuple.Extra+import qualified Data.Vector.Storable as V+import qualified Data.Vector.Storable.Mutable as VM+import Foreign.Storable+import Numeric.Extra+import Prelude+import System.FilePath+import System.IO.Extra+import Safe++import General.IString+import General.Store+import General.Str+import General.Util+import Input.Item+++writeTypes :: StoreWrite -> Maybe FilePath -> [(Maybe TargetId, Item)] -> IO ()+writeTypes store debug xs = do+    let debugger ext body = whenJust debug $ \file -> writeFileUTF8 (file <.> ext) body+    inst <- pure $ Map.fromListWith (+) [(fromIString x,1) | (_, IInstance (Sig _ [TCon x _])) <- xs]+    xs <- writeDuplicates store [(i, fromIString <$> t) | (Just i, ISignature t) <- xs]+    names <- writeNames store debugger inst xs+    xs <- pure $ map (lookupNames names (error "Unknown name in writeTypes")) xs+    writeFingerprints store xs+    writeSignatures store xs++searchTypes :: StoreRead -> Sig String -> [TargetId]+searchTypes store q =+    take nMatches (concat [ search fps qry' | variantClass <- variants+                                            , fpSig <- case headErr variantClass qry of+                                                          (f:_) -> [f]+                                                          []    -> []+                                            , let fps = bestByFingerprint db nMatches fpSig+                                            , variant <- variantClass+                                            , qry' <- variant qry+                                            ])+    where+        nMatches = 100+        qry = lookupNames names name0 (strPack <$> q) -- map unknown fields to name0, i.e. _+        names = readNames store+        search fps sig = concatMap (expandDuplicates $ readDuplicates store)+                         $ searchTypeMatch fps getSig arrow nMatches sig+        db  = zip (readSignatureIndex store)+                  (V.toList $ storeRead store TypesFingerprints :: [Fingerprint])+        getSig = readSignatureAt store+        arrow = lookupCtor store names "->"++        -- Different variations on the search query. Each variation is run in turn until we've gathered+        -- 100 hits or run out of variations to try.+        -- As an optimization, these are grouped by variants that have the same fingerprint, saving+        -- redundant scans through the fingerprint data.+        variants = [ [ pure, permuted ],+                     [ partial, partial >=> permuted ] ]++        -- Permute the arguments of a two-argument query.+        permuted qq = case sigTy qq of+            [a1, a2, r] -> [ qq { sigTy = [a2, a1, r] } ]+            _           -> []++        -- Add a `Maybe` to the query's result type.+        partial  qq = case sigTy qq of+            []  -> []+            tys -> [ qq { sigTy = init tys ++ [TCon maybeCtor [last tys]] } ]++        maybeCtor = lookupCtor store names "Maybe"++lookupCtor :: StoreRead -> Names -> String -> Name+lookupCtor store names c =+    case sigTy (lookupNames names name0 s) of+        [TCon n _] -> n+        _          -> name0+    where+      s = strPack <$> Sig { sigCtx = [], sigTy = [TCon c []] }++searchFingerprintsDebug :: StoreRead -> (String, Sig String) -> [(String, Sig String)] -> [String]+searchFingerprintsDebug store query answers = intercalate [""] $+    f False "Query" query : zipWithFrom (\i -> f True ("Answer " ++ show i)) 1 answers+    where+        qsig = lookupNames names name0 $ strPack <$> snd query+        names = readNames store++        f match name (raw, sig) =+            [name ++ ": " ++ raw+            ,"Sig String: " ++ prettySig sig+            ,"Sig Name: " ++ prettySig (fmap prettyName sn)+            ,"Fingerprint: " ++ prettyFingerprint fp] +++            if not match then [] else+            ["Cost: " ++ maybe "X, no match" show (matchFingerprint qsig fp)+            ,"Explain: " ++ showExplain (matchFingerprintDebug qsig fp)]+            where+                sn = lookupNames names name0 $ strPack <$> sig+                fp = toFingerprint sn++                showExplain = intercalate ", " . map g . sortOn (either (const minBound) (negate . snd))+                g (Left s) = "X " ++ s+                g (Right (s, x)) = show x ++ " " ++ s+++---------------------------------------------------------------------+-- NAME/CTOR INFORMATION++data TypesNames a where TypesNames :: TypesNames (BStr0, V.Vector Name) deriving Typeable++-- At around 7000 packages, Word16 becomes insufficient+-- because there are more than 2^16 Names, so we use Word32.+type NameWord = Word32++-- Must be a unique Name per String.+-- First 0-99 are variables, rest are constructors.+-- More popular type constructors have higher numbers.+-- There are currently about 14K names, so about 25% of the bit patterns are taken+newtype Name = Name NameWord deriving (Eq,Ord,Show,Data,Typeable,Storable,Binary)++name0 = Name 0 -- use to represent _++isCon, isVar :: Name -> Bool+isVar (Name x) = x < 100+isCon = not . isVar++prettyName :: Name -> String+prettyName x@(Name i)+    | x == name0 = "_"+    | isVar x = "v" ++ show i+    | otherwise = "C" ++ show i+++-- | Give a name a popularity, where 0 is least popular, 1 is most popular+popularityName :: Name -> Double+popularityName (Name n) | isVar $ Name n = error "Can't call popularityName on a Var"+                        | otherwise = fromIntegral (n - 100) / fromIntegral (maxBound - 100 :: NameWord)++newtype Names = Names {lookupName :: Str -> Maybe Name}++lookupNames :: Names -> Name -> Sig Str -> Sig Name+lookupNames Names{..} def (Sig ctx typ) = Sig (map f ctx) (map g typ)+    where+        vars = nubOrd $ strPack "_" : [x | Ctx _ x <- ctx] ++ [x | TVar x _ <- universeBi typ]+        var x = Name $ min 99 $ fromIntegral $ fromMaybe (error "lookupNames") $ elemIndex x vars+        con = fromMaybe def . lookupName++        f (Ctx a b) = Ctx (con $ strCons '~' a) (var b)+        g (TCon x xs) = TCon (con x) $ map g xs+        g (TVar x xs) = TVar (var x) $ map g xs+++writeNames :: StoreWrite -> (String -> String -> IO ()) -> Map.Map Str Int -> [Sig Str] -> IO Names+writeNames store debug inst xs = do+    let sigNames (Sig ctx typ) = nubOrd [strCons '~' x | Ctx x _ <- ctx] ++ nubOrd [x | TCon x _ <- universeBi typ]++    -- want to rank highly instances that have a lot of types, and a lot of definitions+    -- eg Eq is used and defined a lot. Constructor is used in 3 places but defined a lot.+    let freq :: Map.Map Str Int = -- how many times each identifier occurs+            Map.unionWith (\typ sig -> sig + min sig typ) (Map.mapKeysMonotonic (strCons '~') inst) $+            Map.fromListWith (+) $ map (,1::Int) $ concatMap sigNames xs+    let names = spreadNames $ Map.toList freq+    debug "names" $ unlines [strUnpack s ++ " = " ++ show n ++ " (" ++ show (freq Map.! s) ++ " uses)" | (s,n) <- names]+    names <- pure $ sortOn fst names+    storeWrite store TypesNames (bstr0Join $ map (strUnpack . fst) names, V.fromList $ map snd names)+    let mp2 = Map.fromAscList names+    pure $ Names $ \x -> Map.lookup x mp2+++-- | Given a list of names, spread them out uniquely over the range [Name 100 .. Name maxBound]+--   Aim for something with a count of p to be at position (p / pmax) linear interp over the range+spreadNames :: [(a, Int)] -> [(a, Name)]+spreadNames [] = []+spreadNames (sortOn (negate . snd) -> xs@((_,limit):_)) = check $ f (99 + fromIntegral (length xs)) maxBound xs+    where+        check xs | all (isCon . snd) xs && length (nubOrd $ map snd xs) == length xs = xs+                 | otherwise = error $ "Invalid spreadNames, length=" ++ show (length xs)++        -- I can only assign values between mn and mx inclusive+        f :: NameWord -> NameWord -> [(a, Int)] -> [(a, Name)]+        f !mn !mx [] = []+        f mn mx ((a,i):xs) = (a, Name real) : f (mn-1) (real-1) xs+            where real = fromIntegral $ max mn $ min mx ideal+                  ideal = mn + floor (fromIntegral (min commonNameThreshold i) * fromIntegral (mx - mn) / fromIntegral (min commonNameThreshold limit))++-- WARNING: Magic constant.+-- Beyond this count names don't accumulate extra points for being common.+-- Ensures that things like Bool (4523 uses) ranks much higher than ShakeOptions (24 uses) by not having+-- [] (10237 uses) skew the curve too much and use up all the available bits of discrimination.+commonNameThreshold = 1024++readNames :: StoreRead -> Names+readNames store = Names $ \x -> Map.lookup (bstrPack $ strUnpack x) mp+    where mp = Map.fromAscList $ zip (bstr0Split s) $ V.toList n+          (s, n) = storeRead store TypesNames+++---------------------------------------------------------------------+-- DUPLICATION INFORMATION++data TypesDuplicates a where TypesDuplicates :: TypesDuplicates (Jagged TargetId) deriving Typeable++newtype Duplicates = Duplicates {expandDuplicates :: Int -> [TargetId]}++-- writeDuplicates xs == nub (map snd xs)+    -- all duplicates are removed, order of first element is preserved+-- (i,x) <- zip [0..] (writeDuplicates xs); expandDuplicates i == map fst (filter ((==) x . snd) xs)+    -- given the result at position i, expandDuplicates gives the TargetId's related to it++writeDuplicates :: Ord a => StoreWrite -> [(TargetId, Sig a)] -> IO [Sig a]+writeDuplicates store xs = do+    -- s=signature, t=targetid, p=popularity (incoing index), i=index (outgoing index)+    xs <- pure $ map (second snd) $ sortOn (fst . snd) $ Map.toList $+        Map.fromListWith (\(x1,x2) (y1,y2) -> (, x2 ++ y2) $! min x1 y1)+                         [(s,(p,[t])) | (p,(t,s)) <- zipFrom (0::Int) xs]+    -- give a list of TargetId's at each index+    storeWrite store TypesDuplicates $ jaggedFromList $ map (reverse . snd) xs+    pure $ map fst xs++readDuplicates :: StoreRead -> Duplicates+readDuplicates store = Duplicates $ V.toList . ask+    where ask = jaggedAsk $ storeRead store TypesDuplicates+++---------------------------------------------------------------------+-- FINGERPRINT INFORMATION++data TypesFingerprints a where TypesFingerprints :: TypesFingerprints (V.Vector Fingerprint) deriving Typeable++data Fingerprint = Fingerprint+    {fpRare1 :: {-# UNPACK #-} !Name -- Most rare ctor, or 0 if no rare stuff+    ,fpRare2 :: {-# UNPACK #-} !Name -- 2nd rare ctor+    ,fpRare3 :: {-# UNPACK #-} !Name -- 3rd rare ctor+    ,fpArity :: {-# UNPACK #-} !Word8 -- Artiy, where 0 = CAF+    ,fpTerms :: {-# UNPACK #-} !Word8 -- Number of terms (where 255 = 255 and above)+    } deriving (Eq,Show,Typeable)++prettyFingerprint :: Fingerprint -> String+prettyFingerprint Fingerprint{..} =+    "arity=" ++ show fpArity ++ ", terms=" ++ show fpTerms +++    ", rarity=" ++ unwords (map prettyName [fpRare1, fpRare2, fpRare3])+++{-# INLINE fpRaresFold #-}+fpRaresFold :: (b -> b -> b) -> (Name -> b) -> Fingerprint -> b+fpRaresFold g f Fingerprint{..} = f fpRare1 `g` f fpRare2 `g` f fpRare3++instance Storable Fingerprint where+    sizeOf _ = 4 * sizeOf name0+    alignment _ = 4+    peekByteOff ptr i = Fingerprint+        <$> peekByteOff ptr (i+0) <*> peekByteOff ptr (i+1*w) <*> peekByteOff ptr (i+2*w)+        <*> peekByteOff ptr (i+3*w) <*> peekByteOff ptr (i+3*w + 1)+        where w = sizeOf name0+    pokeByteOff ptr i Fingerprint{..} = do+        pokeByteOff ptr (i+0) fpRare1 >> pokeByteOff ptr (i+1*w) fpRare2 >> pokeByteOff ptr (i+2*w) fpRare3+        pokeByteOff ptr (i+3*w) fpArity >> pokeByteOff ptr (i+3*w + 1) fpTerms+        where w = sizeOf name0++toFingerprint :: Sig Name -> Fingerprint+toFingerprint sig = Fingerprint{..}+    where fpRare1:fpRare2:fpRare3:_ = sort (nubOrd $ filter isCon $ universeBi sig) ++ [name0,name0,name0]+          fpArity = fromIntegral $ min 255 $ max 0 $ pred $ length $ sigTy sig+          fpTerms = fromIntegral $ min 255 $ length (universeBi sig :: [Name])++writeFingerprints :: StoreWrite -> [Sig Name] -> IO ()+writeFingerprints store xs = storeWrite store TypesFingerprints $ V.fromList $ map toFingerprint xs++data MatchFingerprint a ma = MatchFingerprint+    {mfpAdd :: a -> a -> a+    ,mfpAddM :: ma -> ma -> ma+    ,mfpJust :: a -> ma+    ,mfpCost :: String -> Int -> a+    ,mfpMiss :: String -> ma+    }++matchFingerprint :: Sig Name -> Fingerprint -> Maybe Int+matchFingerprint = matchFingerprintEx MatchFingerprint{..}+    where+        mfpAdd = (+)+        mfpAddM = liftM2 (+)+        mfpJust = Just+        mfpCost _ x = x+        mfpMiss _ = Nothing++matchFingerprintDebug :: Sig Name -> Fingerprint -> [Either String (String, Int)]+matchFingerprintDebug = matchFingerprintEx MatchFingerprint{..}+    where+        mfpAdd = (++)+        mfpAddM = (++)+        mfpJust = id+        mfpCost s x = [Right (s,x)]+        mfpMiss s = [Left s]+++{-# INLINE matchFingerprintEx #-}+matchFingerprintEx :: forall a ma . MatchFingerprint a ma -> Sig Name -> Fingerprint -> ma -- lower is better+matchFingerprintEx MatchFingerprint{..} sig@(toFingerprint -> target) =+    \candidate -> arity (fpArity candidate) `mfpAddM` terms (fpTerms candidate) `mfpAddM` rarity candidate+    where+        -- CAFs must match perfectly, otherwise too many is better than too few+        arity | ta == 0 = \ca -> if ca == 0 then mfpJust $ mfpCost "arity equal" 0 else mfpMiss "arity different and query a CAF" -- searching for a CAF+              | otherwise = \ca -> case fromIntegral ca - fromIntegral ta of+                    _ | ca == 0 -> mfpMiss "arity different and answer a CAF" -- searching for a CAF+                    0  -> mfpJust $ mfpCost "arity equal" 0 -- perfect match+                    -1 -> mfpJust $ mfpCost "arity 1 to remove" 1000 -- not using something the user carefully wrote+                    n | n > 0 && allowMore -> mfpJust $ mfpCost ("arity " ++ show n ++ " to add with wildcard") $ 300 * n -- user will have to make up a lot, but they said _ in their search+                    1  -> mfpJust $ mfpCost "arity 1 to add" 300  -- user will have to make up an extra param+                    2  -> mfpJust $ mfpCost "arity 2 to add"  900  -- user will have to make up two params+                    _ -> mfpMiss ""+            where+                ta = fpArity target+                allowMore = TVar name0 [] `elem` sigTy sig++        -- missing terms are a bit worse than invented terms, but it's fairly balanced, clip at large numbers+        terms = \ct -> case fromIntegral ct - fromIntegral tt of+                n | abs n > 20 -> mfpMiss $ "terms " ++ show n ++ " different" -- too different+                  | n == 0 -> mfpJust $ mfpCost "terms equal" 0+                  | n > 0 -> mfpJust $ mfpCost ("terms " ++ show n ++ " to add") $ n * 10 -- candidate has more terms+                  | otherwise -> mfpJust $ mfpCost ("terms " ++ show (-n) ++ " to remove") $ abs n * 12 -- candidate has less terms+            where+                tt = fpTerms target++        -- given two fingerprints, you have three sets:+        -- Those in common; those in one but not two; those in two but not one+        -- those that are different+        rarity = \cr -> let tr = target in mfpJust $+                differences 5000 400 tr cr `mfpAdd` -- searched for T but its not in the candidate, bad if rare, not great if common+                differences 1000  50 cr tr          -- T is in the candidate but I didn't search for it, bad if rare, OK if common+            where+                fpRaresElem :: Name -> Fingerprint -> Bool+                fpRaresElem !x = fpRaresFold (||) (== x)++                differences :: Double -> Double -> Fingerprint -> Fingerprint -> a+                differences !rare !common !want !have = fpRaresFold mfpAdd f want+                    where f n | fpRaresElem n have = mfpCost ("term in common " ++ prettyName n) 0+                              | n == name0 = mfpCost "term _ missing" 0 -- will pay the cost the other way around+                              | otherwise = let p = popularityName n in mfpCost ("term " ++ prettyName n ++ " (" ++ showDP 2 p ++ ") missing") $+                                            floor $ (p*common) + ((1-p)*rare)+++---------------------------------------------------------------------+-- SIGNATURES++data TypesSigPositions a where TypesSigPositions :: TypesSigPositions (V.Vector Word32) deriving Typeable+data TypesSigData a where TypesSigData :: TypesSigData BS.ByteString deriving Typeable++writeSignatures :: StoreWrite -> [Sig Name] -> IO ()+writeSignatures store xs = do+    v <- VM.new $ length xs+    forM_ (zipFrom 0 xs) $ \(i,x) -> do+        let b = encodeBS x+        storeWritePart store TypesSigData b+        VM.write v i $ fromIntegral $ BS.length b+    v <- V.freeze v+    storeWrite store TypesSigPositions v++type SigLoc = (Word32, Word32)++readSignatureIndex :: StoreRead -> [SigLoc] -- (offset,size) pairs for each field+readSignatureIndex store = zip offsets (V.toList sizes)+  where sizes   = storeRead store TypesSigPositions+        offsets = V.toList $ V.prescanl' (+) 0 sizes++readSignatureAt :: StoreRead -> SigLoc -> Sig Name+readSignatureAt store (offset, size) = decodeBS (BS.take (fromIntegral size)+                                                 $ snd+                                                 $ BS.splitAt (fromIntegral offset) bs)+  where+    bs = storeRead store TypesSigData++---------------------------------------------------------------------+-- TYPE SEARCH++searchTypeMatch :: [ (Int, (Int, SigLoc, Fingerprint)) ]+                -> (SigLoc -> Sig Name)+                -> Name+                -> Int+                -> Sig Name+                -> [Int]+searchTypeMatch possibilities getSig arrow n sig =+    map snd $ takeSortOn fst n+      [ (500 * v + fv, i) | (fv, (i, sigIdx, f)) <- possibilities+                          , v  <- maybeToList (matchType arrow sig $ getSig sigIdx)]++bestByFingerprint :: [(SigLoc, Fingerprint)] -> Int -> Sig Name -> [ (Int, (Int, SigLoc, Fingerprint)) ]+bestByFingerprint db n sig =+  takeSortOn fst (max 5000 n)+    [ (fv, (i, sigIdx, f)) | (i, (sigIdx, f)) <- zipFrom 0 db+                           , fv <- maybeToList (matchFp f) ]+  where+    matchFp = matchFingerprint sig++matchType :: Name -> Sig Name -> Sig Name -> Maybe Int+matchType arr qry ans = unWork <$> lhs `matches` rhs+    where+      lhs = (toTyp arr qry, sigCtx qry)+      rhs = (toTyp arr ans, sigCtx ans)++-- Check if two types-with-context match, returning the amount of work+-- needed to create the match.+matches :: (Typ Name, [Ctx Name]) -> (Typ Name, [Ctx Name]) -> Maybe Work+matches (lhs, lctx) (rhs, rctx) = runST $ evalStateT (getWork go) (Work 0)+  where+    go :: forall s. StateT Work (ST s) Bool+    go = do+        -- Try to unify the answer type with the query type.+        (qry, qryC) <- lift (refTyp True  lhs lctx)+        (ans, ansC) <- lift (refTyp False rhs rctx)+        unifyTyp qry ans >>= \case+            False -> pure False+            True  -> do+                -- Normalize constraints+                let normalize (Ctx c a) = lift (Ctx <$> getName c <*> getName a)+                qryNCs <- Set.fromList <$> (mapM normalize qryC)+                ansNCs <- Set.fromList <$> (mapM normalize ansC)++                nqry <- lift $ normalizeTy qry+                nans <- lift $ normalizeTy ans++                -- Discharge constraints; remove any answer-constraint that is also a query-constraint,+                -- and then remove any remaining answer-constraint that is constraining a concrete type.+                -- TODO: keep constrained concrete types but weight them differently if they correspond+                --       to a known instance (e.g. free if we know the instance, rather expensive otherwise).+                let addl = filter isAbstract (Set.toList $ ansNCs `Set.difference` qryNCs)+                    isAbstract (Ctx c a) = isVar a++                workDelta (Work (3 * length addl))++                pure True++    getWork action = action >>= \case+        True  -> Just <$> get+        False -> pure Nothing++    normalizeTy = \case+        TyVar n tys -> TyVar <$> getName n <*> mapM normalizeTy tys+        TyCon n tys -> TyCon <$> getName n <*> mapM normalizeTy tys+        TyFun args retn -> TyFun <$> mapM normalizeTy args <*> normalizeTy retn+++-- A slight variation on 'Ty', with a special term for functions.+data Typ n+    = TyFun [Typ n] (Typ n)+    | TyCon n [Typ n]+    | TyVar n [Typ n]+  deriving (Eq, Ord, Functor)++-- Rebuild a little bit of recursion-schemes machinery for Typ.+data TypF n t+    = TyFunF [t] t+    | TyConF n [t]+    | TyVarF n [t]+  deriving (Eq, Ord, Functor)++unroll :: Typ n -> TypF n (Typ n)+unroll = \case+    TyFun args retn -> TyFunF args retn+    TyCon n tys     -> TyConF n tys+    TyVar n tys     -> TyVarF n tys++foldTy :: (TypF n a -> a) -> Typ n -> a+foldTy phi = phi . fmap (foldTy phi) . unroll++instance Show n => Show (Typ n) where+    show = foldTy $ \case+        TyFunF typs res -> "<" ++ intercalate ", " typs ++ "; " ++ res ++ ">"+        TyConF n args -> unwords (show n : args)+        TyVarF n args -> unwords (show n : args)++-- Convert a Sig to a Typ.+toTyp :: Name -> Sig Name -> Typ Name+toTyp arrow Sig{..} = case sigTy of+    [] -> error "no types?"+    tys -> let args = init tys+               retn = last tys+           in TyFun (map toTy args) (toTy retn)+  where+    toTy = \case+      TCon n []   | n == arrow -> TyCon n [] -- empty function type?!+      TCon n tys | n == arrow -> TyFun (map toTy (init tys)) (toTy $ last tys)+      TCon n tys -> TyCon n (map toTy tys)+      TVar n tys -> TyVar n (map toTy tys)+++---------------------------------------------------------------------+-- UNIFICATION++-- A union-find data structure for names++type NameRef s = STRef s (NameInfo s)++data NameInfo s =+    NameInfo { niParent :: !(Maybe (NameRef s))+             , niRank   :: !Int+             , niName   :: !Name+             , niFree   :: !Bool+             }+  deriving Eq++-- Find the name of the equivalence class's (current) representative.+getName :: NameRef s -> ST s Name+getName ref = do+    rep <- findRep ref+    niName <$> readSTRef rep++-- Create a new name reference from a name. @fixed == True@ means+-- that the reference cannot be unified with any other fixed refs.+newNameInfo :: Bool -> Name -> ST s (STRef s (NameInfo s))+newNameInfo fixed n = newSTRef $+  NameInfo { niParent = Nothing+           , niRank   = 0+           , niName   = n+           , niFree   = not fixed && isVar n+           }++-- The "find" part of union-find, with path compression.+findRep :: NameRef s -> ST s (NameRef s)+findRep ref = do+    ni <- readSTRef ref+    case niParent ni of+        Nothing -> pure ref+        Just p  -> do+            root <- findRep p+            writeSTRef ref (ni { niParent = Just root })+            pure root++-- The "union" part of union-find, with union-by-rank.+-- Each unification is given a cost of 1 work unit.+unifyName :: NameRef s -> NameRef s -> StateT Work (ST s) Bool+unifyName lhs rhs = do+    lhs' <- lift $ findRep lhs+    rhs' <- lift $ findRep rhs+    lInfo <- lift $ readSTRef lhs'+    rInfo <- lift $ readSTRef rhs'+    let lFree = niFree lInfo+        rFree = niFree rInfo+        lName = niName lInfo+        rName = niName rInfo+    let ok = lFree || rFree || lName == rName+    when (ok && lInfo /= rInfo) $ do+        -- Union by rank, except prefer concrete names over type variables.+        workDelta (Work 1)+        let lRank = niRank lInfo+            rRank = niRank rInfo+        let (root, child) = if not lFree || lRank <= rRank+                            then (lhs', rhs')+                            else (rhs', lhs')+        lift $ modifySTRef' child (\n -> n { niParent = Just root })+        when (lRank == rRank) $ lift $ modifySTRef' root (\n -> n { niRank = lRank + 1 })++    pure ok++-- Allocate new references for each name that appears in the type and context.+refTyp :: Bool -> Typ Name -> [Ctx Name] -> ST s (Typ (NameRef s), [Ctx (NameRef s)])+refTyp fixed t cs =+    evalStateT go Map.empty+  where+    go = do+        ty  <- mkRefs t+        ctx <- forM cs $ \(Ctx c a) -> Ctx <$> getRef c <*> getRef a+        pure (ty, ctx)++    mkRefs = foldTy $ \case+        TyVarF n args    -> TyVar <$> getRef n <*> sequence args+        TyConF n args    -> TyCon <$> getRef n <*> sequence args+        TyFunF args retn -> TyFun <$> sequence args <*> retn++    getRef n = do+        known <- get+        case Map.lookup n known of+            Just ref -> pure ref+            Nothing  -> do+                ref <- lift (newNameInfo fixed n)+                put (Map.insert n ref known)+                pure ref++-- Unify two types.+unifyTyp :: Typ (NameRef s) -> Typ (NameRef s) -> StateT Work (ST s) Bool+unifyTyp lhs rhs = case (lhs, rhs) of+    (TyCon n tys, TyVar n' tys') | length tys == length tys' -> do+            ok <- unifyName n n'+            if not ok+              then pure False+              else and <$> zipWithM unifyTyp tys tys'++    (TyCon n tys, TyCon n' tys') | length tys == length tys' -> do+            ok <- unifyName n n'+            if not ok+              then pure False+              else and <$> zipWithM unifyTyp tys tys'++    (TyVar n tys, TyVar n' tys') | length tys == length tys' -> do+            ok <- unifyName n n'+            if not ok+              then pure False+              else and <$> zipWithM unifyTyp tys tys'++    (TyFun args ret, TyFun args' ret') | length args == length args' -> do+            ok <- unifyTyp ret ret'+            if not ok+              then pure False+              else and <$> zipWithM unifyTyp args args'++    _ -> pure False++-- The total cost of a unification operation.+newtype Work = Work Int++unWork :: Work -> Int+unWork (Work w) = w++workDelta :: Monad m => Work -> StateT Work m ()+workDelta (Work dw) = modify' (\(Work w) -> Work (w + dw))
+ src/Query.hs view
@@ -0,0 +1,249 @@+{-# LANGUAGE PatternGuards, ViewPatterns, RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -O0 #-} -- otherwise it takes a lot of memory to compile on the haskell.org server++module Query(+    Query(..), isQueryName, isQueryType, isQueryScope,+    parseQuery, renderQuery,+    query_test+    ) where++import Data.List+import Language.Haskell.Exts+import Data.Char+import Text.Blaze+import qualified Text.Blaze.XHtml5 as H+import Data.List.Extra+import Data.Generics.Uniplate.Data+import General.Util+import Data.Maybe+import Data.Monoid+import Control.Applicative+import Prelude++---------------------------------------------------------------------+-- DATA TYPE++data Query+    = QueryName {fromQueryName :: String}+    | QueryType {fromQueryType :: Type ()}+    | QueryScope {scopeInclude :: Bool, scopeCategory :: String, scopeValue :: String}+    | QueryNone String -- part of the query that is ignored+      deriving (Show,Eq)++isQueryName, isQueryType, isQueryScope :: Query -> Bool+isQueryName QueryName{} = True; isQueryName _ = False+isQueryType QueryType{} = True; isQueryType _ = False+isQueryScope QueryScope{} = True; isQueryScope _ = False++renderQuery :: [Query] -> Markup+renderQuery [] = H.i "No query"+renderQuery xs = do+    string $ unwords $+        [x | QueryName x <- xs] +++        [":: " ++ pretty x | QueryType x <- xs] +++        [['-' | not scopeInclude] ++ scopeCategory ++ ":" ++ scopeValue | QueryScope{..} <- xs]+    mconcat [" " <> H.del (string x) | QueryNone x <- xs]+++---------------------------------------------------------------------+-- PARSER++parseQuery :: String -> [Query]+parseQuery x = map QueryName nam ++ map QueryType (maybeToList typ) ++ scp+    where+        (scp,rest) = scope_ $ lexer x+        (nam,typ) = divide rest+++openBrackets = ["(#","[:","(","["]+shutBrackets = ["#)",":]",")","]"]++isBracket x = x `elem` (openBrackets ++ shutBrackets)+isBracketPair x = x `elem` zipWith (++) openBrackets shutBrackets++isSym x = ((isSymbol x || isPunctuation x) && x `notElem` special) || x `elem` ascSymbol+    where special = "(),;[]`{}\"'" :: String+          ascSymbol = "!#$%&*+./<=>?@\\^|-~" :: String++isSyms xs | isBracket xs || isBracketPair xs = False+isSyms (x:xs) = isSym x+isSyms [] = False++-- | Split into small lexical chunks.+--+-- > "Data.Map.(!)" ==> ["Data",".","Map",".","(","!",")"]+lexer :: String -> [String]+lexer ('(':',':xs) | (a,')':b) <- span (== ',') xs = ("(," ++ a ++ ")") : lexer b+lexer x | Just s <- (bs !!) <$> findIndex (`isPrefixOf` x) bs = s : lexer (drop (length s) x)+    where bs = zipWith (++) openBrackets shutBrackets ++ openBrackets ++ shutBrackets+lexer (x:xs)+    | isSpace x = " " : lexer (trimStart xs)+    | isAlpha x || x == '_' =+        let (a,b) = span (\x -> isAlphaNum x || x `elem` ("_'#-" :: String)) xs+            (a1,a2) = spanEnd (== '-') a+        in (x:a1) : lexer (a2 ++ b)+    | isSym x = let (a,b) = span isSym xs in (x:a) : lexer b+    | x == ',' = "," : lexer xs+    | otherwise = lexer xs -- drop invalid bits+lexer [] = []+++-- | Find and extract the scope annotations.+--+-- > +package+-- > +module+-- > name.bar+-- > name.++ name.(++) (name.++)+-- > +foo -foo+-- > +scope:foo -scope:foo scope:foo+scope_ :: [String] -> ([Query], [String])+scope_ xs = case xs of+    (readPM -> Just pm):(readCat -> Just cat):":":(readMod -> Just (mod,rest)) -> add pm cat mod rest+    (readPM -> Just pm):(readCat -> Just cat):":-":(readMod -> Just (mod,rest)) -> add False cat mod rest+    (readPM -> Just pm):(readMod -> Just (mod,rest)) -> add_ pm mod rest+    (readCat -> Just cat):":":(readMod -> Just (mod,rest)) -> add True cat mod rest+    (readCat -> Just cat):":.":(readMod -> Just (mod,rest)) -> add True cat ('.':mod) rest+    (readCat -> Just cat):":-":(readMod -> Just (mod,rest)) -> add False cat mod rest+    (readCat -> Just cat):":-.":(readMod -> Just (mod,rest)) -> add False cat ('.':mod) rest+    "(":(readDots -> Just (scp,x:")":rest)) -> out ["(",x,")"] $ add_ True scp rest+    (readDots -> Just (scp,rest)) -> add_ True scp rest+    "(":".":(readDots -> Just (scp,x:")":rest)) -> out ["(",x,")"] $ add_ True ('.':scp) rest+    ".":(readDots -> Just (scp,rest)) -> add_ True ('.':scp) rest+    x:xs -> out [x] $ scope_ xs+    [] -> ([], [])+    where+        out xs (a,b) = (a,xs++b)+        add a b c rest = let (x,y) = scope_ rest in (QueryScope a b c : x, y)+        add_ a c rest = add a b c rest+            where b = if '.' `elem` c || any isUpper (take 1 c) then "module" else "package"++        readPM x = case x of "+" -> Just True; "-" -> Just False; _ -> Nothing++        readCat x | isAlpha1 x = Just x+                  | otherwise = Nothing++        readMod (x:xs) | isAlpha1 x = Just $ case xs of+            ".":ys | Just (a,b) <- readMod ys -> (x ++ "." ++ a, b)+            ".":[] -> (x ++ ".",[])+            ".":" ":ys -> (x ++ "."," ":ys)+            _ -> (x,xs)+        readMod _ = Nothing++        readDots (x:xs) | isAlpha1 x = case xs of+            ".":ys | Just (a,b) <- readDots ys -> Just (x ++ "." ++ a, b)+            ('.':y):ys -> Just (x, [y | y /= ""] ++ ys)+            _ -> Nothing+        readDots _ = Nothing+++-- | If everything is a name, or everything is a symbol, then you only have names.+divide :: [String] -> ([String], Maybe (Type ()))+divide xs | all isAlpha1 ns = (ns, Nothing)+          | all isSyms ns = (ns, Nothing)+          | length ns == 1 = (ns, Nothing)+          | otherwise = case break (== "::") xs of+                (nam, _:rest) -> (names_ nam, typeSig_ rest)+                _ -> ([], typeSig_ xs)+    where ns = names_ xs+++-- | Ignore brackets around symbols, and try to deal with tuple names.+names_ :: [String] -> [String]+names_ ("(":x:")":xs) = [x | x /= " "] ++ names_ xs+names_ ["(",x] = [x]+names_ (x:xs) = [x | x /= " "] ++ names_ xs+names_ [] = []++typeSig_ :: [String] -> Maybe (Type ())+typeSig_ xs = case parseTypeWithMode parseMode $ unwords $ fixup $ filter (not . all isSpace) xs of+    ParseOk x -> Just $ transformBi (\v -> if v == Ident () "__" then Ident () "_" else v) $ fmap (const ()) x+    _ -> Nothing+    where+        fixup = underscore . closeBracket . completeFunc . completeArrow++        completeArrow (unsnoc -> Just (a,b)) | b `elem` ["-","="] = snoc a (b ++ ">")+        completeArrow x = x++        completeFunc (unsnoc -> Just (a,b)) | b `elem` ["->","=>"] = a ++ [b,"_"]+        completeFunc x = x++        closeBracket xs = xs ++ foldl f [] xs+            where f stack x | Just c <- lookup x (zip openBrackets shutBrackets) = c:stack+                  f (s:tack) x | x == s = tack+                  f stack x = stack++        underscore = replace ["_"] ["__"]+++query_test :: IO ()+query_test = testing "Query.parseQuery" $ do+    let want s p (bad,q) = (["missing " ++ s | not $ any p q], filter (not . p) q)+        wantEq v = want (show v) (== v)+        name = wantEq . QueryName+        scope b c v = wantEq $ QueryScope b c v+        typ = wantEq . QueryType . fmap (const ()) . fromParseResult . parseTypeWithMode parseMode+        typpp x = want ("type " ++ x) (\v -> case v of QueryType s -> pretty s == x; _ -> False)+    let infixl 0 ===+        a === f | bad@(_:_) <- fst $ f ([], q) = error $ show (a,q,bad :: [String])+                | otherwise = putChar '.'+            where q = parseQuery a++    "" === id+    "map" === name "map"+    "#" === name "#"+    "c#" === name "c#"+    "-" === name "-"+    "/" === name "/"+    "->" === name "->"+    "foldl'" === name "foldl'"+    "fold'l" === name "fold'l"+    "Int#" === name "Int#"+    "concat map" === name "concat" . name "map"+    "a -> b" === typ "a -> b"+    "a->b" === typ "a -> b"+    "(a b)" === typ "(a b)"+    "map :: a -> b" === typ "a -> b"+    "+Data.Map map" === scope True "module" "Data.Map" . name "map"+    "a -> b package:foo" === scope True "package" "foo" . typ "a -> b"+    "a -> b package:foo-bar" === scope True "package" "foo-bar" . typ "a -> b"+    "Data.Map.map" === scope True "module" "Data.Map" . name "map"+    "[a]" === typ "[a]"+    "++" === name "++"+    "(++)" === name "++"+    ":+:" === name ":+:"+    "bytestring-cvs +hackage" === scope True "package" "hackage" . name "bytestring-cvs"+    "m => c" === typ "m => c"+    "[b ()" === typ "[b ()]"+    "[b (" === typ "[b ()]"+    "_ -> a" === typpp "_ -> a"+    "(a -> b) ->" === typpp "(a -> b) -> _"+    "(a -> b) -" === typpp "(a -> b) -> _"+    "Monad m => " === typpp "Monad m => _"+    "map is:exact" === name "map" . scope True "is" "exact"+    "sort set:hackage" === name "sort" . scope True "set" "hackage"+    "sort -set:hackage" === name "sort" . scope False "set" "hackage"+    "sort set:-hackage" === name "sort" . scope False "set" "hackage"+    "sort -set:-hackage" === name "sort" . scope False "set" "hackage"+    "package:bytestring-csv" === scope True "package" "bytestring-csv"+    "(>>=)" === name ">>="+    "(>>=" === name ">>="+    ">>=" === name ">>="+    "Control.Monad.mplus" === name "mplus" . scope True "module" "Control.Monad"+    "Control.Monad.>>=" === name ">>=" . scope True "module" "Control.Monad"+    "Control.Monad.(>>=)" === name ">>=" . scope True "module" "Control.Monad"+    "(Control.Monad.>>=)" === name ">>=" . scope True "module" "Control.Monad"+    "Control.Monad.(>>=" === name ">>=" . scope True "module" "Control.Monad"+    "(Control.Monad.>>=" === name ">>=" . scope True "module" "Control.Monad"+    "foo.bar" === name "bar" . scope True "package" "foo"+    "insert module:.Map" === name "insert" . scope True "module" ".Map"+    "insert module:Map." === name "insert" . scope True "module" "Map."+    "insert module:.Map." === name "insert" . scope True "module" ".Map."+    ".Map.insert" === name "insert" . scope True "module" ".Map"+    ".Map." === scope True "module" ".Map"+--  FIXME: ".Map" === scope True "module" ".Map" -- probably should work, but really needs to rewrite a fair bit+    "(.Monad.>>=" === name ">>=" . scope True "module" ".Monad"+--  FIXME: "author:Taylor-M.-Hedberg" === scope True "author" "Taylor-M.-Hedberg"+    "author:Bryan-O'Sullivan" === scope True "author" "Bryan-O'Sullivan"+    "\8801" === name "\8801"+    "( )" === id -- FIXME: Should probably be ()
− src/Recipe/All.hs 
@@ -1,199 +0,0 @@-{-# LANGUAGE RecordWildCards, ScopedTypeVariables, DeriveDataTypeable, GeneralizedNewtypeDeriving, CPP #-}--module Recipe.All(recipes) where--import General.Base hiding (readFile')-import General.System as Sys-import General.Util-import Control.Concurrent-import Control.Exception as E-import qualified Data.Map as Map-import qualified Data.Set as Set-import Development.Shake-import Development.Shake.Classes-import Development.Shake.FilePath-import Recipe.Haddock--import Recipe.Command-import Recipe.Keyword-import Recipe.Hackage-import Recipe.Cabal-import Hoogle-import qualified Paths_hoogle as V-import Data.Version-import CmdLine.All as C----- CmdLine is guaranteed to be a constructor of type Data-recipes :: C.CmdLine -> IO ()-recipes opt@Data{..} = withModeGlobalRead $ do-    hSetBuffering stdout NoBuffering-    createDirectoryIfMissing True datadir-    withDirectory datadir $ do-        when redownload $ do-            if nodownload-              then error "Downloads are disabled, cannot re-download"-              else forM_ (urls opt) $ \(file,_) -> removeFile_ $ "downloads" </> file-        when rebuild $ removeFile ".shake.database"-        (count, file) <- withWarnings $ \warn ->-            shake shakeOptions{shakeVersion=showVersion V.version, shakeThreads=threads, shakeProgress=progressSimple} $-                rules opt warn-        putStrLn $ show count ++ " warnings, saved to " ++ file-        putStrLn "Data generation complete"---newtype CabalVersion = CabalVersion String deriving (Show,Typeable,Eq,Hashable,Binary,NFData)-newtype HoogleVersion = HoogleVersion String deriving (Show,Typeable,Eq,Hashable,Binary,NFData)--rules :: C.CmdLine -> ([String] -> IO ()) -> Rules ()-rules opts@Data{..} warn = do-    let srcCabal name ver = "downloads/cabal" </> name </> ver </> name <.> "cabal"-    let srcHoogle name ver = "downloads/hoogle" </> name </> ver </> "doc" </> "html" </> name <.> "txt"--    (\x -> "downloads/*" ?== x &&-           isJust (lookup (takeFileName x) (urls opts))) ?> \out -> do-        when nodownload $-             error "Downloads are disabled; you need to acquire the source files manually."-        let Just url = lookup (takeFileName out) (urls opts)-        putNormal $ "Downloading " ++ out-        wget opts url out-        putNormal $ "Downloaded " ++ out--    "downloads/*.cache" %> \out -> do-        let src = dropExtension out-        need [src]-        src <- liftIO $ readFileUtf8' src-        b <- liftIO $ Sys.doesFileExist out-        liftIO $ if not b then writeFileUtf8 out src else do-            old <- readFileUtf8' out-            when (src /= old) $ writeFileUtf8 out src--    "//*.tar" %> \out -> do-        let src = out <.> "gz"-        need [src]-        ungzip src out--    "//*.index" %> \out -> do-        let src = out -<.> "tar"-        need [src]-        putNormal $ "Extracting tar file " ++ out-        tarExtract src-        putNormal $ "Finished extracting tar file " ++ out-        writeFileChanged out . unlines =<< tarList src--    index <- newCache $ \index -> do-        xs <- readFileLines index-        let asVer = map (read :: String -> Int) . words . map (\x -> if x == '.' then ' ' else x)-        return $ Map.fromListWith (\a b -> if asVer a > asVer b then a else b)-            [(name, ver) | x <- xs, let name = takeDirectory1 x, let ver = takeDirectory1 $ dropDirectory1 x, all (\x -> isDigit x || x == '.') ver]--    verCabal  <- addOracle $ \(CabalVersion  x) -> fmap (Map.lookup x) $ index "downloads/cabal.index"-    verHoogle <- addOracle $ \(HoogleVersion x) -> fmap (Map.lookup x) $ index "downloads/hoogle.index"--    if null actions then want ["default.hoo"] else action $ do-        (good,bad) <- partitionM (fmap isJust . verHoogle . HoogleVersion) actions-        forM_ (delete "all" bad) $ \x -> putNormal $ "Couldn't generate database for " ++ x ++ ", no Hoogle docs available"-        need $ map (<.> "hoo") $ ["all" | "all" `elem` bad] ++ good--    alternatives $ do -- Match *.txt-        "keyword.txt" %> \out -> do-            let src = "downloads/keyword.htm.cache"-            need [src]-            contents <- liftIO $ readFileUtf8' src-            liftIO $ writeFileUtf8 out $ translateKeywords contents--        "default.txt" %> \out -> do-            writeFileLines out ["@combine keyword","@combine package","@combine platform"]--        "platform.txt" %> \out -> do-            contents <- readFile' "downloads/platform.cabal.cache"-            writeFileLines out ["@combine " ++ x | x <- platformPackages contents]--        "package.txt" %> \out -> do-            cabs <- index "downloads/cabal.index"-            xs <- liftIO $ forM (Map.toList cabs) $ \(name,ver) -> do-                src <- try $ readCabal $ srcCabal name ver-                return $ case src of-                    Left (_ :: SomeException) -> []-                    Right src ->-                        [""] ++ zipWith (++) ("-- | " : repeat "--   ") (cabalDescription src) ++-                        ["--","-- Version " ++ ver, "@url package/" ++ name, "@entry package " ++ name]-            liftIO $ writeFileUtf8 out $ unlines $ ("@url " ++ hackage) : "@package package" : concat xs--        "*.txt" %> \out -> do-            let name = takeBaseName out-                base = name == "base"-            cab <- fmap (fmap $ srcCabal name) $ verCabal (CabalVersion name)-            hoo <- if base-                   then need ["downloads/base.txt.cache"] >> return (Just "downloads/base.txt.cache")-                   else fmap (fmap $ srcHoogle name) $ verHoogle (HoogleVersion name)-            hoo <- return $ fromMaybe (error $ "Couldn't find hoogle file for " ++ name) hoo-            hoo <- liftIO $ readFileUtf8' hoo `E.catch` \(_ :: SomeException) -> readFileLatin1' hoo-            deps <- liftIO $ case cab of-                Nothing -> return []-                Just cab -> do-                    res <- try $ readCabal cab-                    case res of-                        Left (err :: SomeException) -> do warn [takeBaseName cab ++ ": failed to read cabal file, " ++ cab ++ ", " ++ show err]; return []-                        Right x -> return $ cabalDepends x-            let cleanDeps = deps \\ (name:avoid)-            loc <- liftIO $ findLocal local name-            liftIO $ writeFileUtf8 out $ unlines $-                ["@depends " ++ a | a <- cleanDeps] ++ haddockHacks loc (lines hoo)--    alternatives $ do -- Match *.hoo-        phony "all.hoo" $ do-            pkgs <- index "downloads/hoogle.index"-            need $ map (<.> "hoo") $ "default" : Map.keys pkgs--        imported <- newCache $ \file -> do-            need [file]-            xs <- liftIO $ readFileUtf8' file-            return [x | x <- lines xs, takeWhile (not . isSpace) x `elem` ["type","data","newtype","class","instance","@depends"]]-        let splitDeps = first (map $ drop 9) . span ("@depends " `isPrefixOf`)--        let genImported seen [] = return []-            genImported seen (t:odo) = do-                v <- if t `Set.member` seen then return Nothing else verHoogle $ HoogleVersion t-                if isNothing v then genImported seen odo else do-                    i <- imported $ t <.> "txt"-                    fmap (i++) $ genImported (Set.insert t seen) (fst (splitDeps i) ++ odo)--        "*.hoo" %> \out -> do-            let src = out -<.> "txt"-            need [src]-            contents <- liftIO $ fmap lines $ readFileUtf8' src-            if not (null contents) && "@combine " `isPrefixOf` head contents then do-                let deps = [x <.> "hoo" | x <- contents, Just x <- [stripPrefix "@combine " x]]-                need deps-                putNormal $ "Creating " ++ out ++ " from " ++ show (length deps) ++ " databases... "-                liftIO $ mergeDatabase deps out-             else do-                (deps, contents) <- return $ splitDeps contents-                deps <- genImported (Set.singleton $ takeBaseName out) deps-                putNormal $ "Creating " ++ out ++ "... "-                liftIO $ createDatabase hackage Haskell [] (unlines deps) $ out -<.> "dep"-                deps <- liftIO $ loadDatabase $ out -<.> "dep"-                err <- liftIO $ createDatabase hackage Haskell [deps] (unlines contents) out-                liftIO $ warn [takeBaseName out ++ ": " ++ show e | e <- err]---urls :: C.CmdLine -> [(FilePath, URL)]-urls Data{..} = let (*) = (,) in-    ["keyword.htm" * "http://wiki.haskell.org/Keywords"-    ,"platform.cabal" * "http://code.haskell.org/haskell-platform/haskell-platform.cabal"-    ,"base.txt" * "http://www.haskell.org/hoogle/base.txt"-    ,"cabal.tar.gz" * (hackage ++ "packages/index.tar.gz")-    ,"hoogle.tar.gz" * (hackage ++ "packages/hoogle.tar.gz")]---withWarnings :: (([String] -> IO ()) -> IO ()) -> IO (Int, FilePath)-withWarnings act = do-    count <- newMVar 0-    let file = ".warnings"-    writeFile file ""-    act $ \xs -> unless (null xs) $ modifyMVar_ count $ \i -> do-        appendFile file $ unlines xs-        return $! i + length xs-    i <- readMVar count-    return (i, file)
− src/Recipe/Cabal.hs 
@@ -1,57 +0,0 @@-{-# LANGUAGE CPP #-}-module Recipe.Cabal(-    Cabal(..), readCabal-    ) where--import Distribution.Compiler-import Distribution.Package-import Distribution.PackageDescription-import Distribution.PackageDescription.Configuration-import Distribution.PackageDescription.Parse-import Distribution.System-import Distribution.Text-import Distribution.Verbosity-import Distribution.Version-import Recipe.Haddock-#if MIN_VERSION_Cabal(1,22,0)-import Language.Haskell.Extension (Language(..))-#endif---ghcVersion = [7,8,3]--data Cabal = Cabal-    {cabalName :: String-    ,cabalVersion :: String-    ,cabalDescription :: [String]-    ,cabalDepends :: [String]-    } deriving Show---readCabal :: FilePath -> IO Cabal-readCabal file = do-    pkg <- readPackageDescription silent file-    let plat = Platform I386 Linux-        compid = CompilerId GHC (Version ghcVersion [])-#if MIN_VERSION_Cabal(1,22,0)-        comp = CompilerInfo-                 { compilerInfoId = compid-                 , compilerInfoAbiTag = NoAbiTag-                 , compilerInfoCompat = Nothing-                 , compilerInfoLanguages = Just [Haskell98, Haskell2010]-                   -- It's too much of a pain to get all the extensions,-                   -- things work anyway.  See 'getExtensions' in-                   -- 'Distribution.Simple.GHC.Internal'.-                 , compilerInfoExtensions = Nothing-                 }-#else-        comp = compid-#endif-    pkg <- return $ case finalizePackageDescription [] (const True) plat comp [] pkg of-        Left _ -> flattenPackageDescription pkg-        Right (pkg,_) -> pkg-    return $ Cabal-        (display $ pkgName $ package pkg)-        (display $ pkgVersion $ package pkg)-        (haddockToHTML $ description pkg)-        [display x | Just l <- [library pkg], Dependency x _ <- targetBuildDepends $ libBuildInfo l]
− src/Recipe/Command.hs 
@@ -1,70 +0,0 @@-{-# LANGUAGE RecordWildCards #-}--module Recipe.Command(wget, ungzip, tarExtract, tarList) where--import General.Base-import General.System-import Development.Shake-import Development.Shake.FilePath-import CmdLine.All as C---wget :: C.CmdLine -> URL -> FilePath -> Action ()-wget opt@Data{..} from to = do-    when nodownload $-         error "Downloads are disabled."-    dl <- liftIO findDownloader-    command [Shell] (dl to from) []---ungzip :: FilePath -> FilePath -> Action ()-ungzip from to = do-    hasGzip <- liftIO $ check "gzip"-    when (isNothing hasGzip) $ error "Could not extract tarballs, could not find tar on the $PATH."-    command [Shell] ("gzip --decompress --stdout --force " ++ from ++ " > " ++ to) []--tarExtract :: FilePath -> Action ()-tarExtract from = do-    hasTar  <- liftIO $ check "tar"-    when (isNothing hasTar) $ error "Could not extract tarballs, could not find tar on the $PATH."-    liftIO $ createDirectoryIfMissing True $ dropExtension from-    command [Shell, Cwd $ dropExtension from] ("tar -xf ../" ++ takeFileName from) []--tarList :: FilePath -> Action [String]-tarList from = do-    hasTar  <- liftIO $ check "tar"-    when (isNothing hasTar) $ error "Could not extract tarballs, could not find tar on the $PATH."-    fmap (lines . fromStdout) $ command [Shell] ("tar -tf " ++ from) []---type Downloader = FilePath -> URL -> String--wget2 :: Downloader-wget2 fp url = "wget -nv --no-check-certificate " ++ url ++ " --output-document=" ++ fp-curl :: Downloader-curl fp url = "curl -sSL " ++ url ++ " --output " ++ fp--findDownloader :: IO Downloader-findDownloader = do-    dl <- check "wget"-    dl <- maybe (check "curl") (return . Just) dl-    when (isNothing dl) $ error "Could not find downloader, neither curl nor wget are on the $PATH."-    return $ matchDl (fromJust dl)-    where matchDl d | "wget" `isInfixOf` d = wget2-                    | "curl" `isInfixOf` d = curl---check :: String -> IO (Maybe FilePath)-check name = do-    res <- findExecutable name-    when (isNothing res) $ do-        putStrLn $ "WARNING: Could not find command line program " ++ name ++ "."-        when isWindows $ putStrLn $ "  You may be able to install it from:\n  " ++ url-    return res-    where-        srcList = [ ("gzip", "http://gnuwin32.sourceforge.net/packages/gzip.htm")-                  , ("tar",  "http://gnuwin32.sourceforge.net/packages/gtar.htm")-                  , ("wget", "http://gnuwin32.sourceforge.net/packages/wget.htm")-                  , ("curl", "http://curl.haxx.se/download.html")-                  ]-        url = fromJust . lookup name $ srcList
− src/Recipe/Hackage.hs 
@@ -1,42 +0,0 @@--module Recipe.Hackage(platformPackages, avoid, findLocal) where--import General.Base-import General.System-import General.Util-import General.Web-import System.FilePath hiding (combine)----- FIXME: This is a list of hack-avoid = words "ghc-prim integer integer-simple integer-gmp rts ghc Win32"----- try and find a local filepath-findLocal :: [FilePath] -> String -> IO (Maybe URL)-findLocal paths name = fmap (listToMaybe . concat . concat) $ forM paths $ \p -> do-    xs <- getDirectoryContents p-    xs <- return [p </> x | x <- reverse $ sort xs, name == fst (rbreak (== '-') x)] -- make sure highest version comes first-    forM xs $ \x -> do-        b <- doesDirectoryExist $ x </> "html"-        x <- return $ if b then x </> "html" else x-        b <- doesFileExist $ x </> "doc-index.html"-        return [filePathToURL $ x </> "index.html" | b]--------------------------------------------------------------------------- READ PLATFORM--platformPackages :: String -> [String]-platformPackages = map fst . parsePlatform--parsePlatform src =-    let xs = takeWhile (not . isPrefixOf "build-tools:" . ltrim) $-             dropWhile (not . isPrefixOf "build-depends:" . ltrim) $-             lines src-    in [(name, takeWhile (\x -> x == '.' || isDigit x) $ drop 1 b)-       | x <- xs, (a,_:b) <- [break (== '=') x], let name = trim $ dropWhile (== '-') $ trim a-       , not $ avoid name]-    where-        avoid x = ("haskell" `isPrefixOf` x && all isDigit (drop 7 x)) ||-                  (x `elem` words "Cabal hpc Win32")
− src/Recipe/Haddock.hs 
@@ -1,145 +0,0 @@-{-# LANGUAGE PatternGuards #-}--module Recipe.Haddock(-    haddockToHTML, haddockHacks-    ) where--import General.Base-import General.Web-import qualified Text.Read as R---data Chunk = Verb [String] | Blk [String] | Li [String] | Numb [String] | Defn [(String,String)] | Para String deriving (Ord,Eq)--haddockToHTML :: String -> [String]-haddockToHTML = intercalate [""] . map (concatMap linewrap . convert) . join . map classify . paragraphs . lines-    where-        empty = all isSpace-        para = unwords . map trim--        paragraphs = filter (not . all empty) . groupBy (\x y -> not (empty x) && not (empty y))-        -        classify xs = case trim (head xs) of-                        "@"    | trim (last xs) == "@", length xs > 1 -> Blk $ tail $ init xs-                            -                        '>':_  | all ((">" `isPrefixOf`) . ltrim) xs  -> Verb $ map (tail . ltrim) xs-                        -                        '[':ys | (cs, ']':zs) <- break (==']') ys     -> Defn [(trim cs, para $ zs : tail xs)]-                        -                        '*':ys                                        -> Li [para $ ys : tail xs]-                        '-':ys                                        -> Li [para $ ys : tail xs]-                        -                        '(':ys | (cs, ')':zs) <- break (==')') ys-                               , all isDigit cs                       -> Numb [para $ zs : tail xs]-                        c:ys | isDigit c-                             , '.':zs <- dropWhile isDigit ys         -> Numb [para $ zs : tail xs]-                        -                        _                                             -> Para $ para xs-                        -        join (Li xs   : Li ys   : zs) = join $ Li   (xs ++ ys) : zs-        join (Numb xs : Numb ys : zs) = join $ Numb (xs ++ ys) : zs-        join (Defn xs : Defn ys : zs) = join $ Defn (xs ++ ys) : zs-        join (x : ys)                 = x : join ys-        join []                       = []--        convert (Verb xs) = ["<pre>"] ++ map escapeHTML xs ++ ["</pre>"]-        convert (Blk  xs) = ["<pre>"] ++ map parseInline xs ++ ["</pre>"]-        convert (Li   xs) = ["<ul>"] ++ ["<li>" ++ x ++ "</li>" | x <- map parseInline xs] ++ ["</ul>"]-        convert (Numb xs) = convert $ Li xs-        convert (Defn xs) = intersperse "" [parseInline a ++ ": " ++ parseInline b | (a,b) <- xs]-        convert (Para s)  = [parseInline s]--        linewrap x | length x > 80 = (a ++ c) : linewrap (drop 1 d)-            where (a,b) = splitAt 60 x-                  (c,d) = break (== ' ') b-        linewrap x = [x | x /= ""]---parseInline :: String -> String-parseInline = concat . bits-    where-        tag x y = "<" ++ x ++ ">" ++ y ++ "</" ++ x ++ ">"--        table = [("@", "@",    Just . tag "tt" . parseInline)-                ,("/", "/",    Just . tag "i" . parseInline)-                ,("<", ">",    check (not . any isSpace) (tag "a"))-                ,("\"","\"",   check isModuleName (tag "a"))-                ,("\'","\'",   check isQName (tag "a"))]--        check f g s = if f s then Just (g s) else Nothing-        sel1 (a,_,_) = a--        bits :: String -> [String]-        bits xs | (st,end,mk):_ <- filter (flip isPrefixOf xs . sel1) table-                , xs <- drop (length st) xs-                , Just (now,next) <- close "" end xs-                , Just r <- mk (reverse now)-                = r : bits next-        bits ('\\':x:xs) = escapeHTML [x] : bits xs-        bits (x:xs) = escapeHTML [x] : bits xs-        bits [] = []--        close acc end xs | end `isPrefixOf` xs = Just (acc, drop (length end) xs)-        close acc end ('\\':x:xs) = close (x:'\\':acc) end xs-        close acc end (x:xs)      = close (x:acc) end xs-        close acc end ""          = Nothing---isModuleName :: String -> Bool-isModuleName = all ok . splitModuleString-    where-        ok s | [(R.Ident (y:ys), "")] <- R.readPrec_to_S R.lexP 0 s = isUpper y-        ok _ = False--splitModuleString :: String -> [String]-splitModuleString = wordsBy (== '.')--wordsBy :: (a -> Bool) -> [a] -> [[a]]-wordsBy f xs = case dropWhile f xs of-                   [] -> []-                   ys -> w : wordsBy f zs-                       where (w, zs) = break f ys--isQName :: String -> Bool-isQName xs = case R.readPrec_to_S R.lexP 0 xs of-                  [(R.Ident (y:ys), '.':zs)] | isUpper y -> isQName zs-                  [(R.Ident ys, "")]                     -> True-                  [(R.Symbol ys, "")]                    -> True-                  _                                      -> False--------------------------------------------------------------------------- HADDOCK HACKS---- Eliminate @version--- Change :*: to (:*:), Haddock bug--- Change !!Int to !Int, Haddock bug--- Change instance [overlap ok] to instance, Haddock bug--- Change instance [incoherent] to instance, Haddock bug--- Change instance [safe] to instance, Haddock bug--- Change !Int to Int, HSE bug--- Drop {-# UNPACK #-}, Haddock bug--- Drop everything after where, Haddock bug--haddockHacks :: Maybe URL -> [String] -> [String]-haddockHacks loc src = maybe id haddockPackageUrl loc (translate src)-    where-        translate :: [String] -> [String]-        translate = map (unwords . g . map f . words) . filter (not . isPrefixOf "@version ")--        f "::" = "::"-        f (':':xs) = "(:" ++ xs ++ ")"-        f ('!':'!':x:xs) | isAlpha x = xs-        f ('!':x:xs) | isAlpha x || x `elem` "[(" = x:xs-        f x | x `elem` ["[overlap","ok]","[incoherent]","[safe]"] = ""-        f x | x `elem` ["{-#","UNPACK","#-}"] = ""-        f x = x--        g ("where":xs) = []-        g (x:xs) = x : g xs-        g [] = []--haddockPackageUrl :: URL -> [String] -> [String]-haddockPackageUrl x = concatMap f-    where f y | "@package " `isPrefixOf` y = ["@url " ++ x, y]-              | otherwise = [y]
− src/Recipe/Keyword.hs 
@@ -1,70 +0,0 @@--module Recipe.Keyword(translateKeywords) where--import General.Base-import Text.HTML.TagSoup---translateKeywords :: String -> String-translateKeywords src = unlines $ keywordPrefix ++ items-    where items = concatMap keywordFormat $ partitions (~== "<span class='mw-headline' id>") $-                  takeWhile (~/= "<div class=printfooter>") $ parseTags src--keywordPrefix =-    ["-- Hoogle documentation, generated by Hoogle"-    ,"-- From http://www.haskell.org/haskellwiki/Keywords"-    ,"-- See Hoogle, http://www.haskell.org/hoogle/"-    ,""-    ,"-- | Haskell keywords, always available"-    ,"@url http://wiki.haskell.org/Keywords"-    ,"@package keyword"-    ]---keywordFormat x = concat ["" : docs ++ ["@url #" ++ concatMap g n, "@entry keyword " ++ noUnderscore n] | n <- name]-    where-        noUnderscore "_" = "_"-        noUnderscore xs = map (\x -> if x == '_' then ' ' else x) xs--        name = words $ f $ fromAttrib "id" (head x)-        docs = zipWith (++) ("-- | " : repeat "--   ") $-               intercalate [""] $-               map docFormat $-               partitions isBlock x--        g x | isAlpha x || x `elem` "_-:" = [x]-            | otherwise = '.' : map toUpper (showHex (ord x) "")--        isBlock (TagOpen x _) = x `elem` ["p","pre","ul"]-        isBlock _ = False--        f ('.':'2':'C':'_':xs) = ' ' : f xs-        f ('.':a:b:xs) = chr res : f xs-            where [(res,"")] = readHex [a,b]-        f (x:xs) = x : f xs-        f [] = []---docFormat :: [Tag String] -> [String]-docFormat (TagOpen "pre" _:xs) = ["<pre>"] ++ map (drop n) ys ++ ["</pre>"]-    where-        ys = lines $ reverse $ dropWhile isSpace $ reverse $ innerText xs-        n = minimum $ map (length . takeWhile isSpace) ys--docFormat (TagOpen "p" _:xs) = g 0 [] $ words $ f xs-    where-        g n acc [] = [unwords $ reverse acc | acc /= []]-        g n acc (x:xs) | nx+1+n > 70 = g n acc [] ++ g nx [x] xs-                       | otherwise = g (n+nx+1) (x:acc) xs-            where nx = length x--        f (TagOpen "code" _:xs) = "<tt>" ++ innerText a ++ "</tt>" ++ f (drop 1 b)-            where (a,b) = break (~== "</code>") xs-        f (x:xs) = h x ++ f xs-        f [] = []--        h (TagText x) = unwords (lines x)-        h _ = ""--docFormat (TagOpen "ul" _:xs) =-    ["<ul><li>"] ++ intercalate ["</li><li>"] [docFormat (TagOpen "p" []:x) | x <- partitions (~== "<li>") xs] ++ ["</li></ul>"]
− src/Test.hs 
@@ -1,35 +0,0 @@-module Main(main) where--import Control.Monad-import System.Process-import System.Directory-import System.Exit-import System.FilePath-import System.Environment-import System.IO.Temp---main :: IO ()-main = do-    let files = ["./dist/build/hoogle/hoogle.exe","./dist/build/hoogle/hoogle"-                ,"./hoogle.exe","./hoogle"-                ,"../hoogle/hoogle.exe","../hoogle/hoogle"]-    found <- filterM doesFileExist files-    let hoogle args want_success = do-            let cmd = normalise (head (found ++ ["hoogle"])) ++ " " ++ args-            res <- system cmd-            when (res /= ExitSuccess && want_success) $-                 error $ "Command: " ++ cmd ++ "\nFailed with: " ++ show res-            when (res == ExitSuccess && not want_success) $-                 error $ "Command: " ++ cmd ++ "\nExpected failure but didn't fail."--    args <- getArgs-    if "--no-net" `elem` args then-        hoogle "test" True-     else do-        hoogle "data" True-        hoogle "test --example" True--    -- Check --no-download functionality in an empty data directory.-    withSystemTempDirectory "hoogle-no-download.test." $ \tempdir -> do-         hoogle ("data --no-download -d" ++ tempdir) False
− src/Test/All.hs 
@@ -1,15 +0,0 @@--module Test.All(test) where--import Test.Parse_TypeSig-import Test.Parse_Query-import Test.Docs-import Test.BWT_FM---test :: IO ()-test = do-    parse_TypeSig-    parse_Query-    docs-    bwt_fm
− src/Test/BWT_FM.hs 
@@ -1,12 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Test.BWT_FM(bwt_fm) where--import Test.General-import General.BurrowsWheeler---bwt_fm = do-    compress "tomorrow and tomorrow and tomorrow" === (31,"wwwdd  nnoooaatttmmmrrrrrrooo  ooo")-    decompress (31,"wwwdd  nnoooaatttmmmrrrrrrooo  ooo") === "tomorrow and tomorrow and tomorrow"-    randCheck $ \x -> decompress (compress x) == x
− src/Test/Docs.hs 
@@ -1,13 +0,0 @@--module Test.Docs(docs) where--import Hoogle.Type.TagStr-import Hoogle.Type.Docs-import Test.General---docs :: IO ()-docs = do-    let a =#= b = renderDocs (readDocsHTML a) === b-    "foo" =#= Str "foo"-    "foo <i>bar</i> baz" =#= Tags [Str "foo ", TagEmph (Str "bar"), Str " baz"]
− src/Test/General.hs 
@@ -1,29 +0,0 @@--module Test.General(parseTest, (===), randCheck) where--import Control.Monad-import qualified Data.ByteString as BS-import Test.QuickCheck(Arbitrary(..), quickCheckWithResult, stdArgs, Testable, Result(..))---instance Arbitrary BS.ByteString where-    arbitrary = fmap BS.pack arbitrary---parseTest :: (Show a, Show e, Eq a) => (String -> Either e a) -> String -> a -> IO ()-parseTest f input output =-    case f input of-        Left x -> err "Parse failed" (show x)-        Right x -> when (x /= output) $ err "Parse not equal" (show x)-    where-        err pre post = error $ pre ++ ":\n  " ++ input ++ "\n  " ++ show output ++ "\n  " ++ post---(===) :: (Show a, Eq a) => a -> a -> IO ()-a === b = when (a /= b) $ error $ "Expected: " ++ show a ++ "\nGot: " ++ show b--randCheck :: Testable a => a -> IO ()-randCheck p = do-    res <- quickCheckWithResult stdArgs p-    let bad = case res of Failure{} -> True; GaveUp{} -> True; _ -> False-    when bad $ error "QuickCheck failed"
− src/Test/Parse_Query.hs 
@@ -1,37 +0,0 @@--module Test.Parse_Query(parse_Query) where--import Prelude()-import General.Base-import Test.General-import Hoogle.Query.All-import Hoogle.Type.All--parse_Query :: IO ()-parse_Query = do-    let (===) = parseTest parseQuery-        q = mempty--    "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 = [Scope True Module "Data.Map"], names = ["map"]}-    "a -> b +foo" === q{scope = [Scope True Package "foo"], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))}-    "a -> b +foo-bar" === q{scope = [Scope True Package "foo-bar"], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))}-    "Data.Map.map" === q{scope = [Scope True Module "Data.Map"], names = ["map"]}-    "[a]" === q{typeSig = Just (TypeSig [] (TApp (TLit "[]") [TVar "a"]))}-    "++" === q{names = ["++"]}-    "(++)" === q{names = ["++"]}-    ":+:" === q{names = [":+:"]}-    "bytestring-cvs +hackage" === q{scope=[Scope True Package "hackage"], names=["bytestring-cvs"]}-
− src/Test/Parse_TypeSig.hs 
@@ -1,76 +0,0 @@--module Test.Parse_TypeSig(parse_TypeSig) where--import Test.General-import Data.Maybe-import Hoogle.Type.All-import Hoogle.Query.All---parse_TypeSig :: IO ()-parse_TypeSig = do-    let parseTypeSig x = either Left (Right . fromMaybe (error $ "Couldn't find type in: " ++ x) . typeSig) $ parseQuery (":: " ++ x)-    let (===) = parseTest parseTypeSig--    -- really basic stuff-    "a" === TypeSig [] (TVar "a")-    "a_" === TypeSig [] (TVar "a_")-    "_" === TypeSig [] (TVar "_")-    "_a" === TypeSig [] (TVar "_a")-    "A" === TypeSig [] (TLit "A")-    "A_" === TypeSig [] (TLit "A_")-    "m a" === TypeSig [] (TApp (TVar "m") [TVar "a"])-    "M a b" === TypeSig [] (TApp (TLit "M") [TVar "a",TVar "b"])--    -- lists and tuples-    "[a]" === TypeSig [] (TApp (TLit "[]") [TVar "a"])-    "[] a" === TypeSig [] (TApp (TLit "[]") [TVar "a"])-    "()" === TypeSig [] (TLit "()")-    "(a)" === TypeSig [] (TVar "a")-    "(a,b)" === TypeSig [] (TApp (TLit "(,)") [TVar "a",TVar "b"])-    "(,) a b" === TypeSig [] (TApp (TLit "(,)") [TVar "a",TVar "b"])-    "Foo [a]" === TypeSig [] (TApp (TLit "Foo") [TApp (TLit "[]") [TVar "a"]])--    -- functions-    "(->)" === TypeSig [] (TLit "->")-    "a -> b" === TypeSig [] (TFun [TVar "a",TVar "b"])-    "a->b->c" === TypeSig [] (TFun [TVar "a",TVar "b",TVar "c"])-    "a -> (b -> c)" === TypeSig [] (TFun [TVar "a",TVar "b",TVar "c"])-    "(a -> b) -> c" === TypeSig [] (TFun [TFun [TVar "a",TVar "b"],TVar "c"])-    "M (a b) c" === TypeSig [] (TApp (TLit "M") [TApp (TVar "a") [TVar "b"],TVar "c"])-    "(-#)" === TypeSig [] (TLit "-#")-    "a -# b" === TypeSig [] (TApp (TLit "-#") [TVar "a",TVar "b"])--    -- classes-    "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"])--    -- forall-    "forall a . a -> a" === TypeSig [] (TFun [TVar "a", TVar "a"])-    "forall a b . a -> a" === TypeSig [] (TFun [TVar "a", TVar "a"])-    "(forall a . a -> a) -> b -> b" === TypeSig [] (TFun [TFun [TVar "a", TVar "a"], TVar "b", TVar "b"])-    "(forall a . Data a => a -> a) -> b -> b" === TypeSig [] (TFun [TFun [TVar "a", TVar "a"], TVar "b", TVar "b"])--    -- type operators-    "(:+:) a b" === TypeSig [] (TApp (TLit ":+:") [TVar "a", TVar "b"])-    "(+++) a b" === TypeSig [] (TApp (TLit "+++") [TVar "a", TVar "b"])-    "a :+: b" === TypeSig [] (TApp (TLit ":+:") [TVar "a", TVar "b"])-    "a +++ b" === TypeSig [] (TApp (TLit "+++") [TVar "a", TVar "b"])--    -- unboxed values-    "Int#" === TypeSig [] (TLit "Int#")-    "State# RealWorld" === TypeSig [] (TApp (TLit "State#") [TLit "RealWorld"])-    "(# a, b #)" === TypeSig [] (TApp (TLit "(#,#)") [TVar "a",TVar "b"])-    "(#,#) a b" === TypeSig [] (TApp (TLit "(#,#)") [TVar "a",TVar "b"])--    -- parallel arrays-    "[:a:]" === TypeSig [] (TApp (TLit "[::]") [TVar "a"])-    "[::] a" === TypeSig [] (TApp (TLit "[::]") [TVar "a"])--    -- real examples-    "(a -> b) -> [a] -> [b]" === TypeSig [] (TFun [TFun [TVar "a",TVar "b"],TApp (TLit "[]") [TVar "a"],TApp (TLit "[]") [TVar "b"]])-    "Monad a => (b -> a c) -> [b] -> a [c]" === TypeSig [TApp (TLit "Monad") [TVar "a"]] (TFun [TFun [TVar "b",TApp (TVar "a") [TVar "c"]],TApp (TLit "[]") [TVar "b"],TApp (TVar "a") [TApp (TLit "[]") [TVar "c"]]])-    "GraphM m gr => Node -> m (gr a b) -> m (Maybe [Node])" === TypeSig [TApp (TLit "GraphM") [TVar "m",TVar "gr"]] (TFun [TLit "Node",TApp (TVar "m") [TApp (TVar "gr") [TVar "a",TVar "b"]],TApp (TVar "m") [TApp (TLit "Maybe") [TApp (TLit "[]") [TLit "Node"]]]])-    "Ix a => Array a b -> a -> b" === TypeSig [TApp (TLit "Ix") [TVar "a"]] (TFun [TApp (TLit "Array") [TVar "a",TVar "b"],TVar "a",TVar "b"])-
− src/Web/All.hs 
@@ -1,12 +0,0 @@--module Web.All(action) where--import CmdLine.All-import General.Web-import Web.Server-import Web.Response---action :: CmdLine -> IO ()-action q@Server{} = server q-action q = cgiResponse =<< response responseArgs q
− src/Web/Page.hs 
@@ -1,59 +0,0 @@--- AUTO GENERATED - do not modify-module Web.Page(Templates(..), defaultTemplates, loadTemplates) where-import Web.Template--data Templates = Templates-  {header :: String -> String -> String -> String -> String-  ,footer :: String -> String-  ,welcome :: String-  ,parseError :: String -> String -> String-  }--defaultTemplates :: Templates-defaultTemplates = Templates _header _footer _welcome _parseError--loadTemplates :: String -> Templates-loadTemplates x = Templates _header _footer _welcome _parseError-    where-        [__header,__footer,__welcome,__parseError] = reload x $-            ("header",["css","js","query","queryHyphen"]) :-            ("footer",["version"]) :-            ("welcome",[]) :-            ("parseError",["errFormat","errMessage"]) :-            []-        _header css js query queryHyphen = __header [css,js,query,queryHyphen]-        _footer version = __footer [version]-        _welcome = __welcome []-        _parseError errFormat errMessage = __parseError [errFormat,errMessage]--_header css js query queryHyphen = ""-  ++ "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">\n    <head profile=\"http://a9.com/-/spec/opensearch/1.1/\">\n        <meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-1\" />\n        <title>"-  ++ escapeHTML query-  ++ " "-  ++ escapeHTML queryHyphen-  ++ " Hoogle</title>\n        <link type=\"text/css\" rel=\"stylesheet\" href=\"res/hoogle.css?version="-  ++ escapeURL css-  ++ "\" />\n        <link type=\"image/png\" rel=\"icon\" href=\"res/favicon.png\" />\n\t\t<link type=\"image/png\" rel=\"apple-touch-icon\" href=\"res/favicon57.png\" />\n        <link type=\"application/opensearchdescription+xml\" rel=\"search\" href=\"res/search.xml\" title=\"Hoogle\" />\n        <script type=\"text/javascript\" src=\"res/jquery.js?version="-  ++ escapeURL js-  ++ "\"> </script>\n        <script type=\"text/javascript\" src=\"res/jquery-cookie.js?version="-  ++ escapeURL js-  ++ "\"> </script>\n        <script type=\"text/javascript\" src=\"res/hoogle.js?version="-  ++ escapeURL js-  ++ "\"> </script>\n    </head>\n    <body>\n<div id=\"links\">\n    <ul id=\"top-menu\">\n        <li id=\"instant\" style=\"display:none;\">\n            <a href=\"javascript:setInstant()\">Instant is <span id=\"instantVal\">off</span></a>\n        </li>\n        <li id=\"plugin\" style=\"display:none;\"><a href=\"javascript:searchPlugin()\">Search plugin</a></li>\n        <li><a href=\"https://github.com/ndmitchell/hoogle/blob/master/README.md\">Manual</a></li>\n        <li><a href=\"http://www.haskell.org/\">haskell.org</a>\n</li>\n    </ul>\n</div>\n<form action=\".\" method=\"get\" id=\"search\">\n    <a id=\"logo\" href=\"http://haskell.org/hoogle/\">\n        <img src=\"res/hoogle.png\" width=\"160\" height=\"58\" alt=\"Hoogle\"\n    /></a>\n    <input name=\"hoogle\" id=\"hoogle\" class=\"HOOGLE_REAL\" type=\"text\" autocomplete=\"off\" accesskey=\"1\" value=\""-  ++ escapeHTML query-  ++ "\" />\n    <input id=\"submit\" type=\"submit\" value=\"Search\" />\n</form>\n<div id=\"body\">\n"--_footer version = ""-  ++ "            <div class=\"push\"></div>\n        </div>\n        <div id=\"footer\">&copy; <a href=\"http://community.haskell.org/~ndm/\">Neil Mitchell</a> 2004-2013, version "-  ++ escapeHTML version-  ++ "</div>\n    </body>\n</html>\n"--_welcome = ""-  ++ "<h1><b>Welcome to Hoogle</b></h1>\n<ul id=\"left\">\n<li><b>Links</b></li>\n<li><a href=\"http://haskell.org/\">Haskell.org</a></li>\n<li><a href=\"http://hackage.haskell.org/\">Hackage</a></li>\n<li><a href=\"http://www.haskell.org/ghc/docs/latest/html/users_guide/\">GHC Manual</a></li>\n<li><a href=\"http://www.haskell.org/ghc/docs/latest/html/libraries/\">Libraries</a></li>\n</ul>\n<p>\n    Hoogle is a Haskell API search engine, which allows you to search many standard Haskell libraries\n    by either function name, or by approximate type signature.\n</p>\n<p id=\"example\">\n    Example searches:<br/>\n     <a href=\"?hoogle=map\">map</a>\n<br/>\n     <a href=\"?hoogle=%28a+-%3e+b%29+-%3e+%5ba%5d+-%3e+%5bb%5d\">(a -&gt; b) -&gt; [a] -&gt; [b]</a>\n<br/>\n     <a href=\"?hoogle=Ord+a+%3d%3e+%5ba%5d+-%3e+%5ba%5d\">Ord a =&gt; [a] -&gt; [a]</a>\n<br/>\n     <a href=\"?hoogle=Data%2eMap%2einsert\">Data.Map.insert</a>\n<br/>\n\t<br/>Enter your own search at the top of the page.\n</p>\n<p>\n    The <a href=\"http://www.haskell.org/haskellwiki/Hoogle\">Hoogle manual</a> contains more details,\n    including further details on search queries, how to install Hoogle as a command line application\n    and how to integrate Hoogle with Firefox/Emacs/Vim etc.\n</p>\n<p>\n    I am very interested in any feedback you may have. Please\n    <a href=\"http://community.haskell.org/~ndm/contact/\">email me</a>, or add an entry to my\n    <a href=\"http://code.google.com/p/ndmitchell/issues/list\">bug tracker</a>.\n</p>\n"--_parseError errFormat errMessage = ""-  ++ "<h1>"-  ++ errFormat-  ++ "</h1>\n<p>\n\t<b>Parse error:</b> "-  ++ escapeHTML errMessage-  ++ "\n</p><p>\n\tFor information on what queries should look like, see the\n\t<a href=\"http://www.haskell.org/haskellwiki/Hoogle\">user manual</a>.\n</p>\n"
− src/Web/Response.hs 
@@ -1,207 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE CPP #-}--module Web.Response(response, ResponseArgs(..), responseArgs) where--import CmdLine.All-import Hoogle-import General.Base-import General.System-import General.Web-import Web.Page-import Data.Generics.Uniplate-#if __GLASGOW_HASKELL__ < 710-import System.Locale-#endif--import qualified Data.Aeson as J-import qualified Data.ByteString.Lazy.Char8 as LBS-import Data.Time.Clock-import Data.Time.Format-import Network.Wai-import Network.HTTP.Types(hContentType)-import System.IO.Unsafe(unsafeInterleaveIO)-import qualified Paths_hoogle(version)-import Data.Version(showVersion)---logFile = "log.txt"-version = showVersion Paths_hoogle.version---data ResponseArgs = ResponseArgs-    {updatedCss :: String-    ,updatedJs :: String-    ,templates :: Templates-    }--responseArgs = ResponseArgs version version defaultTemplates---response :: ResponseArgs -> CmdLine -> IO Response-response ResponseArgs{..} q = do-    logMessage q-    let response x ys = responseOK ((hContentType, fromString x) : ys) . fromString--    dbs <- unsafeInterleaveIO $ case queryParsed q of-        Left _ -> return mempty-        Right x -> fmap snd $ loadQueryDatabases (databases q) (fromRight $ queryParsed q)--    case web q of-        Just "suggest" -> fmap (response "application/json" []) $ runSuggest q-        Just "embed" -> return $ response "text/html" [hdr] $ runEmbed dbs q-            where hdr = (fromString "Access-Control-Allow-Origin", fromString "*")-        Just "ajax" -> return $ response "text/html" [] $ runQuery templates True dbs q-        Just "json" -> return $ responseOK [(hContentType, fromString "application/json")] $ runJson dbs q-        Just "web" -> return $ response "text/html" [] $-            header templates updatedCss updatedJs (queryText q) ['-' | queryText q /= ""] ++-            runQuery templates False dbs q ++ footer templates version-        mode -> return $ response "text/html" [] $ "Unknown webmode: " ++ fromMaybe "none" mode---logMessage :: CmdLine -> IO ()-logMessage q = do-    time <- getCurrentTime-    args <- fmap (fromMaybe [("hoogle",queryText q)]) cgiArgs-    ip <- fmap (fromMaybe "0") $ getEnvVar "REMOTE_ADDR"-    let shw x = if all isAlphaNum x then x else show x-    appendFile logFile $ (++ "\n") $ unwords $-        [formatTime defaultTimeLocale "%FT%T" time-        ,ip] ++-        [shw a ++ "=" ++ shw b | (a,b) <- args]---runSuggest :: CmdLine -> IO String-runSuggest cq@Search{queryText=q} = do-    (_, db) <- loadQueryDatabases (databases cq) mempty-    let res = completions db q-    return $ "[" ++ show q ++ "," ++ show res ++ "]"-runSuggest _ = return ""---runEmbed :: Database -> CmdLine -> String-runEmbed dbs Search{queryParsed = Left err} = "<i>Parse error: " ++& errorMessage err ++ "</i>"-runEmbed dbs cq@Search{queryParsed = Right q}-    | null now = "<i>No results found</i>"-    | otherwise = unlines-        ["<a href='" ++ url ++ "'>" ++ showTagHTML (transform f $ self $ snd x) ++ "</a>"-        | x <- now, let url = fromList "" $ map fst $ locations $ snd x]-    where-        now = take (maybe 10 (max 1) $ count cq) $ search dbs q-        f (TagEmph x) = TagBold x-        f (TagBold x) = x-        f x = x---runJson :: Database -> CmdLine -> LBS.ByteString-runJson dbs Search{queryParsed = Left err} =-    J.encode $ J.object [ fromString "version"    J..= version-                        , fromString "parseError" J..= show err-                        ]-runJson dbs cq@Search{queryParsed = Right q} =-    J.encode $ J.object [ fromString "version"    J..= version-                        , fromString "results"    J..= results-                        ]-    where-        results | q == mempty = []-                | otherwise   = now--        start2 = maybe 0 (subtract 1 . max 0) $ start cq-        count2 = maybe 20 (max 1) $ count cq-        now = map (f . snd) $ take count2 $ drop start2 $ search dbs q--        f Result{..} = J.object-                       [ fromString "location" J..= (head $ map fst locations ++ [""])-                       , fromString "self" J..= showTagText self-                       , fromString "docs" J..= showTagText docs-                       ]---runQuery :: Templates -> Bool -> Database -> CmdLine -> String-runQuery templates ajax dbs Search{queryParsed = Left err} =-    parseError templates (showTagHTMLWith f $ parseInput err) (errorMessage err)-    where-        f (TagEmph x) = Just $ "<span class='error'>" ++ showTagHTMLWith f x ++ "</span>"-        f _ = Nothing---runQuery templates ajax dbs q | fromRight (queryParsed q) == mempty = welcome templates---runQuery templates ajax dbs cq@Search{queryParsed = Right q, queryText = qt} = unlines $-    (if prefix then-        ["<h1>" ++ qstr ++ "</h1>"] ++-        ["<ul id='left'><li><b>Packages</b></li>" ++ also ++ "</ul>" | not $ null pkgs] ++-        ["<p>" ++ showTag sug ++ "</p>" | Just sug <- [suggestions dbs q]] ++-        if null res then-            ["<p>No results found</p>"]-        else-            concat (pre ++ now)-     else-        concat now) ++-    ["<p><a href=\"" ++& urlMore ++ "\" class='more'>Show more results</a></p>" | not $ null post]-    where-        prefix = not $ ajax && start2 /= 0 -- show from the start, with header-        start2 = maybe 0 (subtract 1 . max 0) $ start cq-        count2 = maybe 20 (max 1) $ count cq--        src = search dbs q-        res = [renderRes i (i /= 0 && i == start2 && prefix) x | (i,(_,x)) <- zip [0..] src]-        (pre,res2) = splitAt start2 res-        (now,post) = splitAt count2 res2--        also = concatMap f (take (5 + length minus) $ nub $ minus ++ pkgs)-            where minus = [x | (False,x) <- queryPackages q]-        f x | (True,lx) `elem` queryPackages q =-                let q2 = showTagText $ renderQuery $ querySetPackage Nothing lx q in-                "<li><a class='minus' href='" ++ searchLink q2 ++ "'>" ++ x ++ "</a></li>"-            | (False,lx) `elem` queryPackages q =-                let q2 = showTagText $ renderQuery $ querySetPackage Nothing lx q in-                "<li><a class='plus pad' href='" ++ searchLink q2 ++ "'>" ++ x ++ "</a></li>"-            | otherwise =-                let link b = searchLink $ showTagText $ renderQuery $ querySetPackage (Just b) lx q in-                "<li><a class='minus' href='" ++ link False ++ "'></a>" ++-                "<a class='plus' href='" ++ link True ++ "'>" ++ x ++ "</a></li>"-            where lx = map toLower x-        pkgs = [x | (_, (_,x):_)  <- concatMap (locations . snd) $ take (start2+count2) src]--        urlMore = searchLink qt ++ "&start=" ++ show (start2+count2+1) ++ "#more"-        qstr = showTagHTML (renderQuery q)---renderRes :: Int -> Bool -> Result -> [String]-renderRes i more Result{..} =-        ["<a name='more'></a>" | more] ++-        ["<div class='result'>"] ++-        ["<div class='ans'>" ++ href selfUrl (showTagHTMLWith url self) ++ "</div>"] ++-        ["<div class='from'>" ++ intercalate ", " [unwords $ zipWith (f u) [1..] ps | (u,ps) <- locations] ++ "</div>" | not $ null locations] ++-        ["<div class='doc " ++ (if '\n' `elem` s then " newline" else "") ++ "'><span>" ++ showTag docs ++ "</span></div>"-            | let s = showTagText docs, s /= ""] ++-        ["</div>"]-    where-        selfUrl = head $ map fst locations ++ [""]-        f u cls (url,text) = "<a class='p" ++ show cls ++ "' href='" ++  url2 ++ "'>" ++ text ++ "</a>"-            where url2 = if url == takeWhile (/= '#') u then u else url--        url (TagBold x)-            | null selfUrl = Just $ "<span class='a'>" ++ showTagHTML (transform g x) ++ "</span>"-            | otherwise = Just $ "</a><a class='a' href='" ++& selfUrl ++ "'>" ++ showTagHTML (transform g x) ++-                                 "</a><a class='dull' href='" ++& selfUrl ++ "'>"-        url _ = Nothing--        g (TagEmph x) = TagBold x-        g x = x--        href url x = if null url then x else "<a class='dull' href='" ++& url ++ "'>" ++ x ++ "</a>"---showTag :: TagStr -> String-showTag = showTagHTML . transform f-    where-        f (TagLink "" x) = TagLink (if any (`isPrefixOf` str) ["http:","https:"] then str else searchLink str) x-            where str = showTagText x-        f x = x---searchLink :: String -> URL-searchLink x = "?hoogle=" ++% x
− src/Web/Server.hs 
@@ -1,162 +0,0 @@-{-# LANGUAGE RecordWildCards, ScopedTypeVariables, PatternGuards, CPP #-}-{-# OPTIONS_GHC -fno-warn-unused-imports #-} -- becomes confusing with all the CPP--module Web.Server(server) where--#ifndef MIN_VERSION_wai-#define MIN_VERSION_wai(a,b,c) 1-#endif--import General.Base-import General.Web-import System.FilePath-import CmdLine.All-import Web.Response-import Network.HTTP.Types-import Web.Page-import System.IO.Unsafe(unsafeInterleaveIO)-import Control.Monad.IO.Class-import General.System-import Control.Concurrent-import Control.Exception-import Data.Time.Clock--import Network.Wai-#if MIN_VERSION_wai(2, 0, 0)-import Network.Wai.Internal-#endif-import Network.Wai.Handler.Warp---server :: CmdLine -> IO ()-server q@Server{..} = do-    resp <- respArgs q-    v <- newMVar ()-    putStrLn $ "Starting Hoogle Server on port " ++ show port-    runSettings (setOnException exception $ setPort port defaultSettings)-#if MIN_VERSION_wai(3, 0, 0)-      $ \r sendResponse -> do-#else-      $ \r -> liftIO $ do-#endif-        start <- getCurrentTime-        res <- talk resp q r-        responseEvaluate res-        stop <- getCurrentTime-        let t = floor $ diffUTCTime stop start * 1000-        withMVar v $ const $ putStrLn $ bsUnpack (rawPathInfo r) ++ bsUnpack (rawQueryString r) ++ " ms:" ++ show t-#if MIN_VERSION_wai(3, 0, 0)-        sendResponse res-#else-        return res-#endif---#if MIN_VERSION_wai(2, 0, 0)-exception :: Maybe Request -> SomeException -> IO ()-exception _ e | Just (_ :: InvalidRequest) <- fromException e = return ()-              | otherwise = putStrLn $ "Error: " ++ show e-#else-exception :: SomeException -> IO ()-exception e | Just (_ :: InvalidRequest) <- fromException e = return ()-            | otherwise = putStrLn $ "Error: " ++ show e-#endif---respArgs :: CmdLine -> IO (IO ResponseArgs)-respArgs Server{..} = do-    t <- getTemplate-    if dynamic-        then return $ args t-        else do x <- args t; return $ return x-    where-        getTemplate-            | null template = return $ return defaultTemplates-            | otherwise = do-                let get = do x <- fmap (loadTemplates . unlines) $ mapM readFile' template-                             putStrLn "Templates loaded"-                             return x-                if dynamic then  buffer template get else return get--        modTime ext = unsafeInterleaveIO $ do-            x <- getModificationTime $ resources </> "hoogle" <.> ext-            return $ map (\x -> if isSpace x then '_' else x) $ show x--        args t = do-            css <- modTime "css"; js <- modTime "js"-            t <- t-            return $ responseArgs{updatedCss=css, updatedJs=js, templates=t}----- | Given a set of paths something relies on, and a value to generate it, return something that generates it minimally-buffer :: [FilePath] -> IO a -> IO (IO a)-buffer files act = do-    val <- act-    ts <- mapM getModificationTime files-    ref <- newMVar (ts,val)-    return $ modifyMVar ref $ \(ts,val) -> do-        ts2 <- mapM getModificationTime files-        if ts == ts2 then return ((ts,val),val) else do-            val <- act-            return ((ts2,val),val)----- FIXME: Avoid all the conversions to/from LBS-talk :: IO ResponseArgs -> CmdLine -> Request -> IO Response-talk resp Server{..} r@Request{rawPathInfo=path_, rawQueryString=query_}-    | path `elem` ["/","/hoogle"] = do-        let args = parseHttpQueryArgs $ drop 1 query-        cmd <- cmdLineWeb args-        resp <- resp-        r <- response resp cmd{databases=databases}-        if local_ then rewriteFileLinks r else return r-    | path == "/res/search.xml" = serveSearch resources (fmap bsUnpack $ join $ lookup (fromString "domain") $ queryString r)-    | takeDirectory path == "/res" = serveFile True (resources </> takeFileName path) False-    | local_, Just path <- stripPrefix "/file/" path =-        let hasDrive = "/" `isPrefixOf` path && ":" `isPrefixOf` drop 2 path-        in serveFile False (if hasDrive then drop 1 path else path) local_-    | otherwise = return $ responseNotFound $ show path-    where (path,query) = (bsUnpack path_, bsUnpack query_)---serveSearch :: FilePath -> Maybe String -> IO Response-serveSearch resources domain = do-    r <- serveFile True (resources </> "search.xml") False-    case domain of-        Nothing -> return r-        Just x -> responseRewrite (lbsReplace (fromString "http://haskell.org/hoogle/") (fromString x)) r---serveFile :: Bool -> FilePath -> Bool -> IO Response-serveFile cache file rewriteLinks = do-    b <- doesFileExist file-    if not b-        then return $ responseNotFound file-        else (if rewriteLinks then rewriteHaddockFileLinks else return) $ ResponseFile ok200 hdr file Nothing--    where hdr = (hContentType, fromString $ contentExt $ takeExtension file) :-                [(hCacheControl, fromString "max-age=604800" {- 1 week -}) | cache]---rewriteFileLinks :: Response -> IO Response-rewriteFileLinks = responseRewrite $ lbsReplace (fromString "href='file://") (fromString "href='/file/")--replaceLetter :: LBString -> Char -> LBString-replaceLetter lbs letter = lbsReplace (fromString $ "href=\""++[letter]++":") (fromString $ "href=\"/file/"++[letter]++":") lbs--replaceDriveLetters :: LBString -> LBString-replaceDriveLetters lbs = foldl replaceLetter lbs (['A' .. 'Z'] ++ ['a' .. 'z'])--replaceLeadingSlash :: LBString -> LBString-replaceLeadingSlash = lbsReplace (fromString "href=\"/") (fromString "href=\"/file//")--rewriteHaddockFileLinks :: Response -> IO Response-rewriteHaddockFileLinks = responseRewrite $ replaceDriveLetters . replaceLeadingSlash--contentExt ".png" = "image/png"-contentExt ".css" = "text/css"-contentExt ".js" = "text/javascript"-contentExt ".html" = "text/html"-contentExt ".htm" = "text/html"-contentExt ".xml" = "application/opensearchdescription+xml"-contentExt _ = "text/plain"
− src/Web/Template.hs 
@@ -1,171 +0,0 @@-{-# LANGUAGE PatternGuards, RecordWildCards #-}--module Web.Template(-    main,-    escapeURL, escapeHTML,-    reload-    ) where--import General.Base-import General.System-import General.Web---main :: IO ()-main = do-    [from,to,modname] <- getArgs-    src <- readFile from-    writeFileBinary to $ generate modname $ resolve $ parse src--------------------------------------------------------------------------- TYPE--data Template = Template-    {templateName :: String-    ,templateArgs :: [String]-    ,templateExport :: Bool-    ,templateContents :: [Fragment]-    }--data Fragment-    = Out String -- ^ Output some text-    | Att Esc String -- ^ Output an attribute (and how to escape it)-    | Set String String -- ^ Set an attribute to a value-    | Call String -- ^ Call another template--data Esc = EscNone | EscHtml | EscUrl deriving Eq--escapeStr e = case e of EscHtml -> "escapeHTML "; EscUrl -> "escapeURL "; _ -> ""-escape e = case e of EscHtml -> escapeHTML; EscUrl -> escapeURL; _ -> id---joinOut (Out x:Out y:zs) = joinOut $ Out (x++y) : zs-joinOut (x:xs) = x : joinOut xs-joinOut [] = []---getTemplate :: [Template] -> String -> Template-getTemplate ts x = case find ((==) x . templateName) ts of-    Nothing -> error $ "Could not find template " ++ x-    Just y -> y--------------------------------------------------------------------------- OUTPUT---- Given a set of templates/args you need available, and a piece of sour-reload-    :: String -- ^ The source code-    -> [(String,[String])] -- ^ A set of templates/args you need avaialble-    -> [[String] -> String] -- ^ A list of functions which match the templates/args-reload src want = map f want-    where-        ts = resolve $ parse src--        f (name,args)-            | templateArgs t /= args = error $-                "Arguments for template " ++ name ++ " differ, expected " ++ show args ++ ", got " ++ show (templateArgs t)-            | otherwise = reloadTemplate t-            where t = getTemplate ts name---reloadTemplate :: Template -> ([String] -> String)-reloadTemplate t as = concatMap f $ templateContents t-    where-        atts = zip (templateArgs t) as-        f (Out x) = x-        f (Att e x) = escape e $ fromJust $ lookup x atts--------------------------------------------------------------------------- OUTPUT--generate :: String -> [Template] -> String-generate name xs = unlines $-    ["-- AUTO GENERATED - do not modify"-    ,"module " ++ name ++ "(Templates(..), defaultTemplates, loadTemplates) where"-    ,"import Web.Template"-    ,""-    ,"data Templates = Templates"] ++-    zipWith (++) ("  {":repeat "  ,")-         [templateName t ++ " :: " ++ intercalate " -> " (replicate (length (templateArgs t) + 1) "String") | t <- ts] ++-    ["  }"-    ,""-    ,"defaultTemplates :: Templates"-    ,"defaultTemplates = Templates" ++ concatMap ((++) " _" . templateName) ts-    ,""-    ,"loadTemplates :: String -> Templates"-    ,"loadTemplates x = Templates" ++ concatMap ((++) " _" . templateName) ts-    ,"    where"-    ,"        [" ++ intercalate "," (map ((++) "__" . templateName) ts) ++ "] = reload x $"] ++-    ["            " ++ show (templateName t, templateArgs t) ++ " :" | t <- ts] ++-    ["            []"] ++-    ["        _" ++ unwords (templateName t:templateArgs t) ++-        " = __" ++ templateName t ++ " [" ++ intercalate "," (templateArgs t) ++ "]" | t <- ts] ++-    concatMap generateTemplate ts-    where-        ts = nubBy ((==) `on` templateName) $ filter templateExport xs--generateTemplate :: Template -> [String]-generateTemplate Template{..} = "" :-        (unwords (('_':templateName) : templateArgs) ++ " = \"\"") :-        map ((++) "  " . f) templateContents-    where-        f (Out x) = "++ " ++ show x-        f (Att e x) = "++ " ++ escapeStr e ++ x--------------------------------------------------------------------------- RESOLVE---- | Eliminate Set and Call, fill in the template arguments-resolve :: [Template] -> [Template]-resolve xs = map (resolveFree . resolveSet . resolveCall xs) xs--resolveFree t = t{templateArgs=args}-    where seen = nub [x | Att _ x <- templateContents t]-          args = nub $ filter (`elem` seen) (templateArgs t) ++ seen--resolveSet t = t{templateContents = joinOut $ f [] $ templateContents t}-    where-        f seen (Set x y:xs) = f ((x,y):seen) xs-        f seen (Att e y:xs) | Just v <- lookup y seen = Out (escape e v) : f seen xs-        f seen (x:xs) = x : f seen xs-        f seen [] = []--resolveCall args t = t{templateContents = concatMap f $ templateContents t}-    where-        f (Call x) = concatMap f $ templateContents $ getTemplate args x-        f x = [x]--------------------------------------------------------------------------- PARSING--parse :: String -> [Template]-parse = f . dropWhile (not . isPrefixOf "#") . filter (not . all isSpace) . lines-    where-        f (x:xs) = Template name args exp (parseTemplate $ unlines a) : f b-            where (a,b) = break ("#" `isPrefixOf`) xs-                  ys = words $ dropWhile (== '#') x-                  exp = ["export"] `isPrefixOf` ys-                  name:args = if exp then tail ys else ys-        f [] = []---parseTemplate :: String -> [Fragment]-parseTemplate = f -    where-        f [] = []-        f ('$':xs) = g a : f (drop 1 b)-            where (a,b) = break (== '$') xs-        f xs = Out a : f b-            where (a,b) = break (== '$') xs--        g ('!':xs) = Att EscNone xs-        g ('&':xs) = Att EscHtml xs-        g ('%':xs) = Att EscUrl xs-        g ('#':xs) = Call xs-        g xs | (a,'=':b) <- break (== '=') xs = Set a b-        g x = error $ "Templating error, perhaps you forgot the escape format? $" ++ x ++ "$"