packages feed

hoogle 4.2.43 → 5.0

raw patch · 152 files changed

+6640/−8328 lines, 152 filesdep +conduit-extradep +connectiondep +extradep −Cabaldep −arraydep −blaze-builderdep ~aesondep ~basedep ~bytestringbinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies added: conduit-extra, connection, extra, hoogle, http-conduit, js-flot, js-jquery, mmap, network, network-uri, network-uri-flag, tar, template-haskell, utf8-string, wai-logger, warp-tls, zlib

Dependencies removed: Cabal, array, blaze-builder, case-insensitive, parsec, random, safe, shake, tagsoup, temporary, unix, vector-algorithms

Dependency ranges changed: aeson, base, bytestring, cmdargs, conduit, containers, deepseq, http-types, text, transformers, uniplate, vector, wai, warp

API changes (from Hackage documentation)

- Hoogle: ClassItem :: ItemKind
- Hoogle: DataCtorItem :: ItemKind
- Hoogle: FunctionItem :: ItemKind
- Hoogle: Haskell :: Language
- Hoogle: InstanceItem :: ItemKind
- Hoogle: ModuleItem :: ItemKind
- Hoogle: PackageItem :: ItemKind
- Hoogle: ParseError :: Int -> Int -> String -> TagStr -> ParseError
- Hoogle: Result :: [(URL, [(URL, String)])] -> TagStr -> TagStr -> Result
- Hoogle: Str :: String -> TagStr
- Hoogle: TagBold :: TagStr -> TagStr
- Hoogle: TagColor :: Int -> TagStr -> TagStr
- Hoogle: TagEmph :: TagStr -> TagStr
- Hoogle: TagLink :: String -> TagStr -> TagStr
- Hoogle: Tags :: [TagStr] -> TagStr
- Hoogle: TypeCtorItem :: ItemKind
- Hoogle: TypeSynonymItem :: ItemKind
- Hoogle: UnclassifiedItem :: ItemKind
- Hoogle: [columnNo] :: ParseError -> Int
- Hoogle: [docs] :: Result -> TagStr
- Hoogle: [errorMessage] :: ParseError -> String
- Hoogle: [lineNo] :: ParseError -> Int
- Hoogle: [locations] :: Result -> [(URL, [(URL, String)])]
- Hoogle: [parseInput] :: ParseError -> TagStr
- Hoogle: [self] :: Result -> TagStr
- Hoogle: completions :: Database -> String -> [String]
- Hoogle: createDatabase :: HackageURL -> Language -> [Database] -> String -> FilePath -> IO [ParseError]
- Hoogle: data ItemKind
- Hoogle: data Language
- Hoogle: data ParseError
- Hoogle: data Query
- Hoogle: data Result
- Hoogle: data Score
- Hoogle: data TagStr
- Hoogle: defaultDatabaseLocation :: IO FilePath
- Hoogle: instance Control.DeepSeq.NFData Hoogle.Database
- Hoogle: instance GHC.Base.Monoid Hoogle.Database
- Hoogle: instance GHC.Classes.Eq Hoogle.Result
- Hoogle: instance GHC.Show.Show Hoogle.Database
- Hoogle: instance GHC.Show.Show Hoogle.Result
- Hoogle: loadDatabase :: FilePath -> IO Database
- Hoogle: mergeDatabase :: [FilePath] -> FilePath -> IO ()
- Hoogle: parseQuery :: Language -> String -> Either ParseError Query
- Hoogle: queryDatabases :: Query -> [String]
- Hoogle: queryExact :: Maybe ItemKind -> Query -> Query
- Hoogle: queryPackages :: Query -> [(Bool, String)]
- Hoogle: querySetPackage :: Maybe Bool -> String -> Query -> Query
- Hoogle: renderQuery :: Query -> TagStr
- Hoogle: saveDatabase :: FilePath -> Database -> IO ()
- Hoogle: scoring :: [(Score, Score)] -> IO String
- Hoogle: search :: Database -> Query -> [(Score, Result)]
- Hoogle: showDatabase :: Database -> Maybe [String] -> String
- Hoogle: showTagANSI :: TagStr -> String
- Hoogle: showTagHTML :: TagStr -> String
- Hoogle: showTagHTMLWith :: (TagStr -> Maybe String) -> TagStr -> String
- Hoogle: showTagText :: TagStr -> String
- Hoogle: suggestions :: Database -> Query -> Maybe TagStr
+ Hoogle: Target :: URL -> Maybe (String, URL) -> Maybe (String, URL) -> String -> String -> String -> Target
+ Hoogle: [targetDocs] :: Target -> String
+ Hoogle: [targetItem] :: Target -> String
+ Hoogle: [targetModule] :: Target -> Maybe (String, URL)
+ Hoogle: [targetPackage] :: Target -> Maybe (String, URL)
+ Hoogle: [targetType] :: Target -> String
+ Hoogle: [targetURL] :: Target -> URL
+ Hoogle: data Target
+ Hoogle: hoogle :: [String] -> IO ()
+ Hoogle: searchDatabase :: Database -> String -> [Target]
+ Hoogle: withDatabase :: NFData a => FilePath -> (Database -> IO a) -> IO a

Files

CHANGES.txt view
@@ -1,15 +1,11 @@ Changelog for Hoogle -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+5.0+    #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     #96, allow certicate verification failures     #95, allow a higher version of Cabal on older GHCs
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Neil Mitchell 2004-2016.+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,13 +1,19 @@-# 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)+# 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/lts?label=Stackage)](https://www.stackage.org/package/hoogle) [![Linux Build Status](https://img.shields.io/travis/ndmitchell/hoogle.svg?label=Linux%20build)](https://travis-ci.org/ndmitchell/hoogle) [![Windows Build Status](https://img.shields.io/appveyor/ci/ndmitchell/hoogle.svg?label=Windows%20build)](https://ci.appveyor.com/project/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.**+The development branch for Hoogle version 5. The current released version lives on the `hoogle4` branch. For details of the current state and future direction see [this blog post](http://neilmitchell.blogspot.co.uk/2015/01/hoogle-5-is-coming.html). +----------++**This page describes how Hoogle 5 might work, and has not yet been fully implemented.** ++----------+ 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. -* **Online version:** http://haskell.org/hoogle-* **Hackage page:** http://hackage.haskell.org/packages/hoogle+* **Online version:** https://www.haskell.org/hoogle/+* **Hackage page:** https://hackage.haskell.org/package/hoogle * **Source code:** http://github.com/ndmitchell/hoogle-* **Bug tracker:** http://code.google.com/p/ndmitchell/issues/list+* **Bug tracker:** https://github.com/ndmitchell/hoogle/issues  ## Hoogle Use @@ -15,8 +21,9 @@  * **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.+* **From `emacs`**, by means of [`engine-mode`](https://github.com/hrs/engine-mode)+* **[Installed locally](https://github.com/ndmitchell/hoogle/blob/master/docs/Install.md)**, with either a command line or in a browser+* **[As a developer](https://github.com/ndmitchell/hoogle/blob/master/docs/API.md)**, through Haskell or JSON APIs.  # Searches @@ -83,6 +90,14 @@ [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).  +### The Source Code++<tt>$ darcs get http://code.haskell.org/hoogle/</tt>++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 [http://code.google.com/p/ndmitchell/issues/list bug tracker] 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.@@ -102,9 +117,13 @@ The folders in the distribution, 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.)  ## Similar Tools@@ -140,3 +159,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++)+    {+        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,132 @@ cabal-version:      >= 1.10 build-type:         Simple name:               hoogle-version:            4.2.43+version:            5.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-2016 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:           http://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==8.0.1, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3 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/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:   Haskell98      build-depends:+        QuickCheck,+        aeson,         base > 4 && < 5,-        array, containers, directory, filepath, process, random,-        safe,         binary,-        bytestring >= 0.9,-        conduit >= 0.2,+        bytestring,+        cmdargs,+        conduit,+        conduit-extra,+        connection,+        containers,+        deepseq,+        directory,+        extra >= 1.4,+        filepath,+        haskell-src-exts >= 1.16 && < 1.18,+        http-conduit,+        http-types,+        js-flot,+        js-jquery,+        mmap,+        network,+        network-uri,+        old-locale,+        process,         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+        tar,+        template-haskell,+        text,+        time,+        transformers,+        uniplate,+        utf8-string,+        vector,+        wai,+        wai-logger,+        warp,+        warp-tls,+        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+     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.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:   Haskell98+    ghc-options:        -threaded      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+        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,362 @@+/********************************************************************+*  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, #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;+}+++/********************************************************************+*  LEFT - EXTRA SUGGESTIONS+*/++#left {+    float: left;+    width: 140px;+    margin: 0px;+    padding: 0px;+    margin-left: 10px;+    overflow: hidden;+}++#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: 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;+}++.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;+}++.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,414 @@++// 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(){return $scope && $scope.val() !== "set:stackage" ? $scope.val() : "";}++        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.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();}+    }+}+++/////////////////////////////////////////////////////////////////////+// 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","");+});++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 = 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,39 @@+<!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" 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><a href="https://www.haskell.org">haskell.org</a></li>+    </ul>+</div>+<form action="." method="get" id="search">+    <a id="logo" href="http://hoogle.haskell.org">+        <img src="#{cdn}hoogle.png" width="160" height="58" alt="Hoogle"+    /></a>+    <input name="hoogle" id="hoogle" class="HOOGLE_REAL" type="text" autocomplete="off" 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 class="push"></div>+        </div>+        <div id="footer">&copy; <a href="http://ndmitchell.com">Neil Mitchell</a> 2004-2016, 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,69 @@+<!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="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>++<script type="text/javascript">+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();+        }+    });++});+</script>++    </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/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="http://hoogle.haskell.org/?hoogle={searchTerms}"/>+    <Url type="application/x-suggestions+json" template="http://hoogle.haskell.org/?hoogle={searchTerms}&amp;mode=suggest"/>++    <Image height="16" width="16" type="image/png">http://hoogle.haskell.org/favicon.png</Image>+    <Image height="64" width="64" type="image/png">http://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,34 @@+<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 style="border:2px solid red; font-weight: bold; background-color: yellow; padding: 10px; text-align: center;">+    Warning: <a href="http://neilmitchell.blogspot.co.uk/2015/01/hoogle-5-is-coming.html">Alpha version, type search doesn't work</a>!+</p>+<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/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,135 @@+{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-missing-fields -fno-cse #-}++module Action.CmdLine(+    CmdLine(..), Language(..), getCmdLine,+    defaultGenerate,+    whenLoud, whenNormal+    ) where++import System.Console.CmdArgs+import System.Directory+import System.Environment+import System.FilePath+import Data.List.Extra+import Data.Version+import Paths_hoogle(version)++data Language = Haskell | Frege deriving (Data,Typeable,Show,Eq,Enum,Bounded)++data CmdLine+    = Search+        {color :: Maybe Bool+        ,link :: Bool+        ,numbers :: Bool+        ,info :: Bool+        ,database :: FilePath+        ,count :: Int+        ,query :: [String]+        ,repeat_ :: Int+        ,language :: Language+        ,compare_ :: [String]+        }+    | Generate+        {download :: Maybe Bool+        ,database :: FilePath+        ,insecure :: Bool+        ,include :: [String]+        ,local_ :: Maybe FilePath+        ,debug :: Bool+        ,language :: Language+        }+    | Server+        {port :: Int+        ,database :: FilePath+        ,cdn :: String+        ,logs :: FilePath+        ,local :: Bool+        ,language :: Language+        ,scope :: String+        ,host :: String+        ,https :: Bool+        ,cert :: FilePath+        ,key :: FilePath+        }+    | Replay+        {logs :: FilePath+        ,database :: FilePath+        ,repeat_ :: Int+        ,language :: Language+        ,scope :: String+        }+    | Test+        {deep :: Bool+        ,database :: FilePath+        ,language :: Language+        }+      deriving (Data,Typeable,Show)++getCmdLine :: [String] -> IO CmdLine+getCmdLine args = do+    args <- withArgs args $ cmdArgsRun cmdLineMode++    -- fill in the default database+    args <- if database args /= "" then return args else do+        dir <- getAppUserDataDirectory "hoogle"+        return $ args{database=dir </> "default-" ++ lower (show $ language args) ++ "-" ++ showVersion version ++ ".hoo"}++    -- 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."+            return $ args{include = delete "all" include}+        _ -> return args++    return args+++defaultGenerate :: CmdLine+defaultGenerate = generate{language=Haskell}+++cmdLineMode = cmdArgsMode $ modes [search_ &= auto,generate,server,replay,test]+    &= verbosity &= program "hoogle"+    &= summary ("Hoogle " ++ showVersion version ++ ", http://hoogle.haskell.org/")++search_ = Search+    {color = def &= name "colour" &= help "Use colored output (requires ANSI terminal)"+    ,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 result"+    ,database = def &= typFile &= help "Name of database to use (use .hoo extension)"+    ,count = 10 &= name "n" &= help "Maximum number of results to return"+    ,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 <- [minBound..maxBound]] &= 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"+    ,debug = def &= help "Generate debug information"+    } &= help "Generate Hoogle databases"++server = Server+    {port = 80 &= 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"+    ,scope = def &= help "Default scope to start with"+    ,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)"+    } &= 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"+    } &= help "Run the test suite"
+ src/Action/Generate.hs view
@@ -0,0 +1,234 @@+{-# LANGUAGE ViewPatterns, TupleSections, RecordWildCards, ScopedTypeVariables, PatternGuards #-}++module Action.Generate(actionGenerate) where++import Data.List.Extra+import System.FilePath+import System.Directory.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 as Map+import qualified Data.Text as T+import Control.Monad.Extra+import Control.Applicative+import Data.Monoid+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 System.Mem+import System.IO+import GHC.Stats+import Action.CmdLine+import General.Conduit++{-+++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  = undefined+-}+++-- -- 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 String Package, Set.Set String, Source IO (String, URL, LStr))+readHaskellOnline timing settings download = do+    stackage <- download "haskell-stackage.txt" "https://www.stackage.org/lts/cabal.config"+    platform <- download "haskell-platform.txt" "https://raw.githubusercontent.com/haskell/haskell-platform/master/hptool/src/Releases2015.hs"+    ghcapi   <- download "haskell-ghcapi.txt" $ "https://downloads.haskell.org/~ghc/" ++ ghcApiVersion ++ "/docs/html/libraries/ghc-" ++ ghcApiVersion ++ "/ghc.txt"+    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 <- setStackage stackage+    setPlatform <- setPlatform platform+    setGHC <- setGHC platform++    cbl <- timed timing "Reading Cabal" $ parseCabalTarball settings cabals+    let want = Set.insert "ghc" $ Set.unions [setStackage, setPlatform, setGHC]+    cbl <- return $ flip Map.mapWithKey cbl $ \name p ->+        p{packageTags =+            [(T.pack "set",T.pack "included-with-ghc") | name `Set.member` setGHC] +++            [(T.pack "set",T.pack "haskell-platform") | name `Set.member` setPlatform] +++            [(T.pack "set",T.pack "stackage") | name `Set.member` setStackage] +++            packageTags p}++    let source = do+            tar <- liftIO $ tarballReadFiles hoogles+            forM_ tar $ \(takeBaseName -> name, src) ->+                yield (name, hackagePackageURL name, src)+            src <- liftIO $ strReadFile ghcapi+            let url = "https://downloads.haskell.org/~ghc/" ++ ghcApiVersion ++ "/docs/html/libraries/ghc-" ++ ghcApiVersion ++ "/"+            yield ("ghc", url, lstrFromChunks [src])+    return (cbl, want, source)+++readHaskellDir :: Timing -> FilePath -> IO (Map.Map String Package, Set.Set String, Source IO (String, URL, LStr))+readHaskellDir timing dir = do+    packages <- map (takeBaseName &&& id) . filter ((==) ".txt" . takeExtension) <$> listFiles dir+    let source = forM_ packages $ \(name, file) -> do+            src <- liftIO $ strReadFile file+            yield (name, hackagePackageURL name, lstrFromChunks [src])+    return (Map.fromList $ map ((,mempty{packageTags=[(T.pack "set",T.pack "all")]}) . fst) packages+           ,Set.fromList $ map fst packages, source)+++readFregeOnline :: Timing -> Download -> IO (Map.Map String Package, Set.Set String, Source IO (String, URL, LStr))+readFregeOnline timing download = do+    frege <- download "frege-frege.txt" "http://try.frege-lang.org/hoogle-frege.txt"+    let source = do+            src <- liftIO $ strReadFile frege+            yield ("frege", "http://google.com/", lstrFromChunks [src])+    return (Map.empty, Set.singleton "frege", source)+++readHaskellGhcpkg :: Timing -> Settings -> IO (Map.Map String Package, Set.Set String, Source IO (String, URL, LStr))+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 </> name <.> "txt"+                whenM (liftIO $ doesFileExist file) $ do+                    src <- liftIO $ strReadFile file+                    docs <- liftIO $ canonicalizePath docs+                    let url = "file://" ++ ['/' | not $ all isPathSeparator $ take 1 docs] +++                              replace "\\" "/" (addTrailingPathSeparator docs)+                    yield (name, url, lstrFromChunks [src])+    cbl <- return $ let ts = map (both T.pack) [("set","stackage"),("set","installed")]+                    in Map.map (\p -> p{packageTags = ts ++ packageTags p}) cbl+    return (cbl, Map.keysSet cbl, source)+++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+    gcStats <- getGCStatsEnabled++    download <- return $ downloadInput timing insecure download (takeDirectory database)+    settings <- loadSettings+    (cbl, want, source) <- case language of+        Haskell | Just "" <- local_ -> readHaskellGhcpkg timing settings+                | Just dir <- local_ -> readHaskellDir timing dir+                | otherwise -> readHaskellOnline timing settings download+        Frege | isJust local_ -> errorIO "No support for local Frege databases"+              | otherwise -> readFregeOnline timing download+    let (cblErrs, popularity) = packagePopularity cbl+    want <- return $ if include /= [] then Set.fromList include else 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 :: Conduit (Int, (String, URL, LStr)) IO (Maybe Target, [Item])+                consume = awaitForever $ \(i, (pkg, url, body)) -> do+                    timedOverwrite timing ("[" ++ show i ++ "/" ++ show (Set.size want) ++ "] " ++ pkg) $+                        parseHoogle (\msg -> warning $ pkg ++ ":" ++ msg) url body++            writeItems store $ \items -> do+                let packages = [ fakePackage name $ "Not in Stackage, so not searched.\n" ++ T.unpack packageSynopsis+                               | (name,Package{..}) <- Map.toList cbl, name `Set.notMember` want]++                (seen, xs) <- runConduit $+                    source =$=+                    filterC (flip Set.member want . fst3) =$=+                        ((fmap Set.fromList $ mapC fst3 =$= sinkList) |$|+                        (((zipFromC 1 =$= consume) >> when (null include) (sourceList packages))+                            =$= pipelineC 10 (items =$= sinkList)))++                let missing = [x | x <- Set.toList $ want `Set.difference` seen+                                 , fmap packageLibrary (Map.lookup x cbl) /= Just False]+                whenNormal $ when (missing /= []) $ do+                    putStrLn $ ("Packages not found: " ++) $ unwords $ sortOn lower missing+                when (Set.null seen) $+                    exitFail "No packages were found, aborting (use no arguments to index all of Stackage)"++                itemWarn <- readIORef itemWarn+                when (itemWarn > 0) $+                    putStrLn $ "Found " ++ show itemWarn ++ " warnings when processing items"+                return [(a,b) | (a,bs) <- xs, b <- bs]++        itemsMb <- if not gcStats then return 0 else do performGC; GCStats{..} <- getGCStats; return $ currentBytesUsed `div` (1024*1024)+        xs <- timed timing "Reodering items" $ return $! reorderItems settings (\s -> maybe 1 negate $ Map.lookup s popularity) xs+        timed timing "Writing tags" $ writeTags store (`Set.member` want) (\x -> maybe [] (map (both T.unpack) . 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++        when gcStats $ do+            stats@GCStats{..} <- getGCStats+            x <- getVerbosity+            when (x >= Loud) $+                print stats+            when (x >= Normal) $ do+                putStrLn $ "Peak of " ++ show peakMegabytesAllocated ++ "Mb, " ++ show itemsMb ++ "Mb for items"++    when debug $+        writeFile (database `replaceExtension` "store") $ unlines stats
+ src/Action/Search.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE TupleSections, RecordWildCards, ScopedTypeVariables #-}++module Action.Search(actionSearch, withSearch, search, action_search_test) where++import Control.Monad.Extra+import Control.DeepSeq+import Data.Maybe+import qualified Data.Set as Set+import Data.List.Extra+import Data.Functor.Identity+import System.Directory++import Output.Items+import Output.Tags+import Output.Names+import Output.Types+import General.Store+import Query+import Input.Item+import Action.CmdLine+import General.Util+++-- -- 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+            (q, res) <- return $ search store $ parseQuery $ unwords query+            whenLoud $ putStrLn $ "Query: " ++ unescapeHTML (renderQuery q)+            let (shown, hidden) = splitAt count $ nubOrd $ map targetItem res+            if null res then+                putStrLn "No results found"+             else if info then do+                let Target{..} = head res+                putStrLn (unHTML targetItem)+                let packageModule = map fst $ catMaybes [targetPackage, targetModule]+                unless (null packageModule) $ do+                    putStrLn (unwords packageModule)+                putStrLn (unHTML targetDocs)+             else do+                let toShow = if numbers && not info then addCounter shown else shown+                putStr $ unlines $ map unHTML toShow+                when (hidden /= []) $ 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 $ searchTypesDebug store (parseType $ unwords query) (map parseType compare_)++    where unHTML = unescapeHTML . innerTextHTML++addCounter :: [String] -> [String]+addCounter = zipWith (\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) <- return $ applyTags store qs+    is <- case (filter isQueryName qs, filter isQueryType qs) of+        ([], [] ) -> return list+        ([], t:_) -> return $ searchTypes store $ hseToSig $ fromQueryType t+        (xs, [] ) -> return $ searchNames store exact $ map fromQueryName xs+        (xs, t:_) -> do+            nam <- return $ Set.fromList $ searchNames store exact $ map fromQueryName xs+            return $ filter (`Set.member` nam) $ searchTypes store $ hseToSig $ fromQueryType t+    let look = lookupItem store+    return (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 a ==$ f = do+            res <- return $ snd $ search store (parseQuery a)+            case res of+                Target{..}:_ | f targetURL -> putChar '.'+                _ -> error $ "Searching for: " ++ show a ++ "\nGot: " ++ show (take 1 res)+    let a === b = a ==$ (== b)+    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","package:emily","package:henry"]+     else do+        "base" === hackage "base"+        "Prelude" === hackage "base/docs/Prelude.html"+        "map" === hackage "base/docs/Prelude.html#v:map"+        "map package:base" === hackage "base/docs/Prelude.html#v:map"+        "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/Data-List.html#v:foldl-39-"+        "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/Data-Monoid.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 "cmdargs"+        "author:Neil-Mitchell category:Development" === hackage "derive"+        "( )" ==$ 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" === ("https://downloads.haskell.org/~ghc/" ++ ghcApiVersion ++ "/docs/html/libraries/ghc-" ++ ghcApiVersion ++ "/TyCon.html#v:visibleDataCons")++        let tags = completionTags store+        let asserts b x = if b then putChar '.' else error $ "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"
+ src/Action/Server.hs view
@@ -0,0 +1,254 @@+{-# LANGUAGE ViewPatterns, TupleSections, RecordWildCards, ScopedTypeVariables, PatternGuards #-}++module Action.Server(actionServer, actionReplay, action_server_test_, action_server_test) where++import Data.List.Extra+import System.FilePath+import Control.Exception+import Control.DeepSeq+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+import System.IO.Extra+import General.Str+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 GHC.Stats+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 Prelude++import qualified Data.Aeson.Encode 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 -> "hoogle=" `isInfixOf` x && not ("is:ping" `isInfixOf` x)+    putStrLn . showDuration =<< time+    evaluate spawned+    dataDir <- getDataDir+    withSearch database $ \store ->+        server log cmd $ replyServer log local store cdn (dataDir </> "html") scope++actionReplay :: CmdLine -> IO ()+actionReplay Replay{..} = withBuffering stdout NoBuffering $ do+    src <- readFile logs+    let qs = [readInput url | _:ip:_:url:_ <- map words $ lines src, ip /= "-"]+    (t,_) <- duration $ withSearch database $ \store -> do+        log <- logNone+        dataDir <- getDataDir+        let op = replyServer log False 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 -> StoreRead -> String -> FilePath -> String -> Input -> IO Output+replyServer log local store cdn htmlDir scope = \Input{..} -> case inputURL of+    -- without -fno-state-hack things can get folded under this lambda+    [] -> do+        let grab name = [x | (a,x) <- inputArgs, a == name, x /= ""]+        let qScope = let xs = grab "scope" in [scope | null xs && scope /= ""] ++ xs+        let qSource = grab "hoogle" ++ filter (/= "set:stackage") qScope+        let q = concatMap parseQuery qSource+        let (q2, results) = search store q+        let body = showResults local inputArgs q2 $ dedupeTake 25 (\t -> t{targetURL="",targetPackage=Nothing, targetModule=Nothing}) results+        case lookup "mode" $ reverse inputArgs of+            Nothing | qSource /= [] -> fmap OutputString $ templateRender templateIndex $ map (second str)+                        [("tags",tagOptions qScope)+                        ,("body",body)+                        ,("title",unwords qSource ++ " - Hoogle")+                        ,("search",unwords $ grab "hoogle")+                        ,("robots",if any isQueryScope q then "none" else "index")]+                    | otherwise -> OutputString <$> templateRender templateHome []+            Just "body" -> OutputString <$> if null qSource then templateRender templateEmpty [] else return $ lstrPack body+            Just "json" -> return $ OutputJSON $ JSON.encode $ take 100 results+            Just m -> return $ OutputFail $ lstrPack $ "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 = (now `subtractTime` spawned) / (24 * 60 * 60)+        let s = show errs ++ " errors since yesterday, running for " ++ showDP 2 alive ++ " days."+        return $ if errs == 0 && alive < 1.5 then OutputString $ lstrPack $ "Happy. " ++ s else OutputFail $ lstrPack $ "Sad. " ++ s+    ["log"] -> do+        log <- displayLog <$> logSummary log+        OutputHTML <$> templateRender templateLog [("data",str log)]+    ["stats"] -> do+        stats <- getGCStatsEnabled+        if stats then do+            x <- getGCStats+            return $ OutputString $ lstrPack $ replace ", " "\n" $ takeWhile (/= '}') $ drop 1 $ dropWhile (/= '{') $ show x+         else+            return $ OutputFail $ lstrPack "GHC Statistics is not enabled, restart with +RTS -T"+    "file":xs | local -> do+        let x = ['/' | not isWindows] ++ intercalate "/" xs+        return $ OutputFile $ x ++ (if hasTrailingPathSeparator x then "index.html" else "")+    xs ->+        -- avoid "" and ".." in the URLs, since they could be trying to browse on the server+        return $ OutputFile $ joinPath $ htmlDir : filter (not . all (== '.')) xs+    where+        str = templateStr . lstrPack+        tagOptions sel = concat [tag "option" ["selected=selected" | x `elem` sel] x | x <- completionTags store]+        params = map (second str)+            [("cdn",cdn),("jquery",if null cdn then "plugin/jquery.js" else JQuery.url)+            ,("version",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",str $ tagOptions []),("body",templateEmpty),("title",str "Hoogle"),("search",str ""),("robots",str "index")]+        templateLog = templateFile (htmlDir </> "log.html") `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 -> [(String, String)] -> [Query] -> [[Target]] -> String+showResults local args query results = unlines $+    ["<h1>" ++ renderQuery query ++ "</h1>"+    ,"<ul id=left>"+    ,"<li><b>Packages</b></li>"] +++    [tag_ "li" $ f cat val | (cat,val) <- itemCategories $ concat results, QueryScope True cat val `notElem` query] +++    ["</ul>"] +++    ["<p>No results found</p>" | null results] +++    ["<div class=result>" +++     "<div class=ans><a href=\"" ++ showURL local targetURL ++ "\">" ++ displayItem query targetItem ++ "</a></div>" +++     "<div class=from>" ++ showFroms local is  ++ "</div>" +++     "<div class=\"doc newline shut\">" ++ targetDocs ++ "</div>" +++     "</div>"+    | is@(Target{..}:_) <- results]+    where+        add x = escapeHTML $ ("?" ++) $ intercalate "&" $ map (joinPair "=") $+            case break ((==) "hoogle" . fst) args of+                (a,[]) -> a ++ [("hoogle",x)]+                (a,(_,x1):b) -> a ++ [("hoogle",x1 ++ " " ++ x)] ++ b++        f cat val = "<a class='minus' href='" ++ add ("-" ++ cat ++ ":" ++ val) ++ "'></a>" +++                    "<a class='plus' href='" ++ add (cat ++ ":" ++ val) ++ "'>" +++                    (if cat == "package" then "" else cat ++ ":") ++ val ++ "</a>"+++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 -> [Target] -> String+showFroms local xs = intercalate ", " $ for pkgs $ \p ->+    let ms = filter ((==) p . targetPackage) xs+    in unwords ["<a href=\"" ++ showURL local b ++ "\">" ++ a ++ "</a>" | (a,b) <- catMaybes $ p : map remod ms]+    where+        remod Target{..} = do (a,_) <- targetModule; return (a,targetURL)+        pkgs = nubOrd $ map targetPackage xs++showURL :: Bool -> URL -> String+showURL True (stripPrefix "file:///" -> Just x) = "file/" ++ x+showURL _ x = x+++-------------------------------------------------------------+-- DISPLAY AN ITEM (bold keywords etc)++highlightItem :: [Query] -> String -> String+highlightItem qs x+    | Just (pre,x) <- stripInfix "<0>" x, Just (name,post) <- stripInfix "</0>" x = pre ++ highlight (unescapeHTML name) ++ post+    | otherwise = x+    where+        highlight = concatMap (\xs@((b,_):_) -> let s = escapeHTML $ map snd xs in if b then "<b>" ++ s ++ "</b>" else s) .+                    groupOn fst . (\x -> zip (f x) x)+            where+              f (x:xs) | m > 0 = replicate m True ++ drop (m - 1) (f xs)+                  where m = maximum $ 0 : [length y | QueryName y <- qs, lower y `isPrefixOf` lower (x:xs)]+              f (x:xs) = False : f xs+              f [] = []++displayItem :: [Query] -> String -> String+displayItem = highlightItem+++action_server_test_ :: IO ()+action_server_test_ = do+    testing "Action.Server.displayItem" $ do+        let expand = replace "{" "<b>" . replace "}" "</b>" . replace "<0>" "" . replace "</0>" ""+            contract = replace "{" "" . replace "}" ""+        let q === s | displayItem (parseQuery q) (contract s) == expand s = putChar '.'+                    | otherwise = error $ show (q,s,displayItem (parseQuery q) (contract s))+        "test" === "<0>my{Test}</0> :: Int -&gt; test"+        "new west" === "<0>{newest}_{new}</0> :: Int"+        "+*" === "(<0>{+*}&amp;</0>) :: Int"+        "+<" === "(<0>&gt;{+&lt;}</0>) :: Int"+        "foo" === "<i>data</i> <0>{Foo}d</0>"+        "foo" === "<i>type</i> <0>{Foo}d</0>"+        "foo" === "<i>type family</i> <0>{Foo}d</0>"+        "foo" === "<i>module</i> Foo.Bar.<0>F{Foo}</0>"+        "foo" === "<i>module</i> <0>{Foo}o</0>"++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 q === want = do+                OutputString (lstrUnpack -> res) <- replyServer log False store "" (dataDir </> "html") "" (Input [] [("hoogle",q)])+                if want `isInfixOf` res then putChar '.' else fail $ "Bad substring: " ++ res+        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 summaryAverage +++                        ",errors:" ++ show summaryErrors ++ "}"
+ src/Action/Test.hs view
@@ -0,0 +1,44 @@+{-# 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 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+    input_hoogle_test+    query_test+    action_server_test_+    putStrLn ""++    putStrLn "Sample database tests"+    actionGenerate defaultGenerate{database=sample, local_=Just "misc/sample-data"}+    action_search_test True sample+    action_server_test True sample+    putStrLn ""++    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,108 @@+{-# LANGUAGE NoMonomorphismRestriction, PatternGuards, Rank2Types, CPP #-}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- QSem was deprecated in 7.6, but then undeprecated++module General.Conduit(+    module Data.Conduit, MonadIO, liftIO,+    sourceList, sinkList, sourceLStr,+    foldC, mapC, mapMaybeC, mapAccumC, filterC, concatC,+    mapMC, mapAccumMC,+    (|$|), pipelineC, groupOnLastC,+    zipFromC, linesC, linesCR+    ) where++import Data.Conduit+import Data.Conduit.List 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+++concatC = C.concat+mapC = C.map+mapMC = C.mapM+foldC = C.fold+mapMaybeC = C.mapMaybe+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 -> Conduit a m (i, a)+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 => Consumer a 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) -> Conduit a m a+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+++-- | I use this version as in older versions of Conduit the equivalent is O(n^2).+--   https://github.com/snoyberg/conduit/pull/209+linesC :: Monad m => Conduit Str m Str+linesC = loop []+    where+        loop acc = await >>= maybe (finish acc) (go acc)++        finish acc = unless (BS.null final) (yield final)+            where final = BS.concat $ reverse acc++        go acc more = case BS.uncons second of+            Just (_, second') -> yield (BS.concat $ reverse $ first:acc) >> go [] second'+            Nothing -> loop $ more:acc+            where (first, second) = BS.break (== '\n') more++linesCR :: Monad m => Conduit Str m Str+linesCR = linesC =$= mapC f+    where f x | Just (x, '\r') <- bsUnsnoc x = x+              | otherwise = x++bsUnsnoc :: BS.ByteString -> Maybe (BS.ByteString, Char)+#if __GLASGOW_HASKELL__ < 708+bsUnsnoc x | BS.null x = Nothing+           | otherwise = Just (BS.init x, BS.last x)+#else+bsUnsnoc = BS.unsnoc+#endif++sourceLStr :: Monad m => LStr -> Producer m Str+sourceLStr = sourceList . lstrToChunks+++pipelineC :: Int -> Consumer o IO r -> Consumer o 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+                return $ 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,42 @@+{-# LANGUAGE PatternGuards, DeriveDataTypeable #-}++-- | Interned strings+module General.IString(+    IString, fromIString, toIString+    ) where++import Data.Data+import Data.IORef+import Control.DeepSeq+import Data.String+import qualified Data.Map as Map+import System.IO.Unsafe+++data IString = IString {-# UNPACK #-} !Int !String+    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 = fromIString+instance Read IString where readsPrec _ x = [(toIString x,"")]+instance IsString IString where fromString = toIString+instance NFData IString where rnf (IString _ _) = () -- we force the string at construction time++{-# NOINLINE istrings #-}+istrings :: IORef (Map.Map String IString)+istrings = unsafePerformIO $ newIORef Map.empty++fromIString :: IString -> String+fromIString (IString _ x) = x++toIString :: String -> IString+toIString x | () <- rnf 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,123 @@+{-# 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.Time.Calendar+import Data.Time.Clock+import Numeric.Extra+import Control.Monad.Extra+import qualified Data.Set as Set+import qualified Data.Map.Strict as Map+import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Monoid+import General.Util+import Data.Maybe+import Data.List+import Data.IORef+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; return $ Log Nothing ref (const False)++logCreate :: Either Handle FilePath -> (String -> Bool) -> IO Log+logCreate store interesting = do+    (h, old) <- case store of+        Left h -> return (h, Map.empty)+        Right file -> do+            b <- doesFileExist file+            mp <- if not b then return Map.empty else withFile file ReadMode $ \h -> do+                src <- LBS.hGetContents h+                let xs = mapMaybe (parseLogLine interesting) $ LBS.lines src+                return $! 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+    return $ Log (Just var) ref interesting++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 user) 1 taken (toAverage taken) (if isJust err then 1 else 0)+     else if isJust err then+        add mempty{iErrors=1}+     else+        return ()+    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 :: Int+    ,summaryUses :: Int+    ,summarySlowest :: Double+    ,summaryAverage :: Double+    ,summaryErrors :: Int+    }++-- Summary accumulating+data SummaryI = SummaryI+    {iUsers :: !(Set.Set String) -- number of distinct users+    ,iUses :: !Int -- number of uses+    ,iSlowest :: !Double -- slowest result+    ,iAverage :: !(Average Double) -- average result+    ,iErrors :: !Int -- number of errors+    }++instance Monoid SummaryI where+    mempty = SummaryI Set.empty 0 0 (toAverage 0) 0+    mappend (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 (head $ Set.toList x) y+                    | Set.size y == 1 = Set.insert (head $ Set.toList y) x+                    | otherwise = Set.union x y++summarize :: Day -> SummaryI -> Summary+summarize date SummaryI{..} = Summary date (Set.size iUsers) iUses iSlowest (fromAverage iAverage) iErrors++parseLogLine :: (String -> Bool) -> LBS.ByteString -> Maybe (Day, SummaryI)+parseLogLine interesting (LBS.words -> time:user:dur:query:err)+    | user /= LBS.pack "-"+    , Just [a, b, c] <- fmap (map fst) $ mapM LBS.readInt $ LBS.split '-' $ LBS.takeWhile (/= 'T') time+    = Just (fromGregorian (fromIntegral a) b c, SummaryI+        (if use then Set.singleton $ LBS.unpack user else Set.empty)+        (if use then 1 else 0)+        (if use then dur2 else 0)+        (toAverage $ if use then dur2 else 0)+        (if [LBS.pack "ERROR:"] `isPrefixOf` err then 1 else 0))+    where use = interesting $ LBS.unpack query+          dur2 = let s = LBS.unpack dur in fromMaybe 0 $+                 if '.' `elem` s then readMaybe s else (/ 1000) . intToDouble <$> readMaybe s+parseLogLine _ _ = Nothing+++logSummary :: Log -> IO [Summary]+logSummary Log{..} = map (uncurry summarize) . Map.toAscList <$> readIORef logCurrent
+ src/General/Store.hs view
@@ -0,0 +1,244 @@+{-# LANGUAGE ScopedTypeVariables, RecordWildCards, PatternGuards, ViewPatterns, DeriveDataTypeable, GADTs #-}++module General.Store(+    Typeable, Stored,+    intSize, intFromBS, intToBS, encodeBS, decodeBS,+    StoreWrite, storeWriteFile, storeWrite, storeWritePart,+    StoreRead, storeReadFile, storeRead,+    Jagged, jaggedFromList, jaggedAsk,+    ) where++import Data.IORef.Extra+import System.IO.Extra+import Data.Typeable+import qualified Data.Map as Map+import qualified Data.Vector.Storable as V+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Unsafe as BS+import qualified Data.ByteString.Lazy as LBS+import Foreign.C.String+import Foreign.Storable+import Foreign.Ptr+import Foreign.ForeignPtr+import Control.Monad.Extra+import Control.Exception+import Numeric.Extra+import Data.Binary+import Data.List.Extra+import System.IO.MMap+import Control.Applicative+import System.IO.Unsafe+import General.Util+import Control.DeepSeq+import Data.Version+import Data.Char+import Paths_hoogle+import Prelude++-- ensure the string is always 25 chars long, so version numbers don't change its size+verString = BS.pack $ take 25 $ "HOOGLE-" ++ showVersion 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+        return $ 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+    withBinaryFile file WriteMode $ \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) $+            error "Some duplicate names have been written out"++        -- 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]+        return (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 $ typeOf (undefined :: a)+    atoms <- case swAtoms of+        (keyOld,a):xs | part, key == keyOld -> do+            let size = atomSize a + len+            evaluate size+            return $ (key,a{atomSize=size}) : xs+        _ -> return $ (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) $+        error $ "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+            error $ "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+            error $ "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) $+        error $ "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 $ typeOf (undefined :: a)+    let corrupt msg = error $ "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,92 @@+{-# LANGUAGE PatternGuards #-}++-- | ByteString wrappers which don't require special imports and are all UTF8 safe+module General.Str(+    Str, strPack, strUnpack, strReadFile, strSplitInfix, strNull, strConcat, strStripPrefix, strStripSuffix, strLines, strTrimStart, strUnlines, strUnwords,+    LStr, lstrPack, lstrUnpack, lstrLines, lstrToChunks, lstrFromChunks, lstrToStr,+    Str0, join0, split0+    ) 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 Data.Char+import Data.List+++type Str = BS.ByteString++type LStr = LBS.ByteString+++strPack :: String -> Str+strPack = US.fromString++strUnpack :: Str -> String+strUnpack = US.toString++strReadFile :: FilePath -> IO Str+strReadFile = BS.readFile++strSplitInfix :: Str -> Str -> Maybe (Str, Str)+strSplitInfix needle haystack+    | (a,b) <- BS.breakSubstring needle haystack+    , not $ BS.null b+    = Just (a, BS.drop (BS.length needle) b)+strSplitInfix _ _ = Nothing++strNull :: Str -> Bool+strNull = BS.null++strConcat :: [Str] -> Str+strConcat = BS.concat++strStripPrefix :: Str -> Str -> Maybe Str+strStripPrefix needle x+    | BS.isPrefixOf needle x = Just $ BS.drop (BS.length needle) x+    | otherwise = Nothing++strStripSuffix :: Str -> Str -> Maybe Str+strStripSuffix needle x+    | BS.isSuffixOf needle x = Just $ BS.take (BS.length x - BS.length needle) x+    | otherwise = Nothing++strTrimStart :: Str -> Str+strTrimStart = BS.dropWhile isSpace++strUnlines :: [Str] -> Str+strUnlines = BS.unlines++strLines :: Str -> [Str]+strLines = BS.lines++strUnwords :: [Str] -> Str+strUnwords = BS.unwords++lstrLines :: LStr -> [LStr]+lstrLines = LBS.lines++lstrToChunks :: LStr -> [Str]+lstrToChunks = LBS.toChunks++lstrToStr :: LStr -> Str+lstrToStr = LBS.toStrict++lstrFromChunks :: [Str] -> LStr+lstrFromChunks = LBS.fromChunks++lstrUnpack :: LStr -> String+lstrUnpack = LUS.toString++lstrPack :: String -> LStr+lstrPack = LUS.fromString+++type Str0 = Str++join0 :: [String] -> Str0+join0 = BS.pack . intercalate "\0"++split0 :: Str0 -> [Str]+split0 = 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,109 @@+{-# LANGUAGE PatternGuards, DeriveDataTypeable, ScopedTypeVariables #-}++module General.Template(+    Template, templateFile, templateStr, templateApply, templateRender+    ) where++import Data.Data+import Data.Monoid+import General.Str+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 Str -- a real variable+          | App Tree [(Str, Tree)] -- applies a foo string to the lambda+          | Lit Str+          | 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 <$> strReadFile file+        f x = return x++        parse x | Just (a,b) <- strSplitInfix (strPack "#{") x+                , Just (b,c) <- strSplitInfix (strPack "}") 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 = mconcat $ map fromLit a, x /= mempty] ++ g b+            where (a,b) = span isLit xs++treeEval :: Tree -> [Str]+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)+    return $ 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 return t else do+            t <- treeOptimise <$> treeRemoveLam t0+            writeIORef ref (new,t)+            return t++templateTree :: Tree -> Template+templateTree t = Template t $ treeCache t++templateFile :: FilePath -> Template+templateFile = templateTree . Lam++templateStr :: LStr -> Template+templateStr = templateTree . List . map Lit . lstrToChunks++templateApply :: Template -> [(String, Template)] -> Template+templateApply (Template t _) args = templateTree $ App t [(strPack a, b) | (a,Template b _) <- args]++templateRender :: Template -> [(String, Template)] -> IO LStr+templateRender (Template _ t) args = do+    t <- t+    let Template t2 _ = templateApply (Template t $ return t) args+    lstrFromChunks . treeEval <$> treeRemoveLam t2
+ src/General/Timing.hs view
@@ -0,0 +1,81 @@+{-# 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 GHC.Stats+import Control.Monad.IO.Class+++data Timing = Timing+    {timingOffset :: IO Seconds+    ,timingStore :: IORef [(String, Seconds)] -- records for writing to a file+    ,timingOverwrite :: IORef (Maybe (Seconds, Int)) -- if you are below T you may overwrite N characters+    ,timingTerminal :: Bool -- is this a terminal+    }+++withTiming :: Maybe FilePath -> (Timing -> IO a) -> IO a+withTiming file f = do+    timingOffset <- offsetTime+    timingStore <- newIORef []+    timingOverwrite <- newIORef Nothing+    timingTerminal <- hIsTerminalDevice stdout++    res <- f Timing{..}+    total <- timingOffset+    whenJust file $ \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 <- return $ reverse $ sortOn snd $ ("Unrecorded", total - sum (map snd xs)) : xs+        writeFile file $ unlines $ prettyTable 2 "Secs" xs+    putStrLn $ "Took " ++ showDuration total+    return res+++-- skip it if have written out in the last 1s and takes < 0.1+++timed :: MonadIO m => Timing -> String -> m a -> m a+timed = timedEx False++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 >> return (length msg)+    undo1 <- out $ msg ++ "... "+    liftIO $ hFlush stdout++    res <- act+    end <- liftIO timingOffset+    let time = end - start+    liftIO $ modifyIORef timingStore ((msg,time):)++    stats <- liftIO getGCStatsEnabled+    s <- if not stats then return "" else do GCStats{..} <- liftIO getGCStats; return $ " (" ++ show peakMegabytesAllocated ++ "Mb)"+    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 ""+    return 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,322 @@+{-# LANGUAGE PatternGuards, ViewPatterns, CPP, ScopedTypeVariables #-} -module General.Util where+module General.Util(+    URL,+    pretty, parseMode, applyType, applyFun1, unapplyFun, fromName, fromQName, fromTyVarBind, declNames, isTypeSig,+    tarballReadFiles,+    isUpper1, isAlpha1,+    splitPair, joinPair,+    testing, testing_, testEq,+    showUTCTime,+    strict,+    withs,+    escapeHTML, unescapeHTML, innerTextHTML, tag, tag_,+    takeSortOn,+    Average, toAverage, fromAverage,+    inRanges,+    readMaybe,+    exitFail,+    prettyTable,+    ghcApiVersion,+    hackagePackageURL, hackageModuleURL, hackageDeclURL, ghcModuleURL,+    minimum', maximum', minimumBy', maximumBy',+    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.Monoid+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 Foreign.Storable+import Data.Int+import System.IO+import System.Exit+#if __GLASGOW_HASKELL__< 710+import System.Locale+#endif+import Prelude -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+-- | A URL, complete with a @https:@ prefix.+type URL = String +ghcApiVersion :: String+ghcApiVersion = "8.0.1" --- | Only append strings if neither one is empty-(++?) :: String -> String -> String-a ++? b = if null a || null b then [] else a ++ b+exitFail :: String -> IO ()+exitFail msg = do+    hPutStrLn stderr msg+    exitFailure -groupOn f = groupBy ((==) `on` f)-nubOn f = nubBy ((==) `on` f)+pretty :: Pretty a => a -> String+pretty = prettyPrintWithMode defaultMode{layout=PPNoLayout} -sortFst mr = sortOn fst mr-groupFst mr = groupOn fst mr +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] -groupFsts :: Eq k => [(k,v)] -> [(k,[v])]-groupFsts = map (fst . head &&& map snd) . groupFst+applyType :: Type -> [Type] -> Type+applyType x (t:ts) = applyType (TyApp x t) ts+applyType x [] = x -sortGroupFsts mr = groupFsts . sortFst $ mr-sortGroupFst mr = groupFst . sortFst $ mr+applyFun1 :: [Type] -> Type+applyFun1 [x] = x+applyFun1 (x:xs) = TyFun x $ applyFun1 xs +unapplyFun :: Type -> [Type]+unapplyFun (TyFun x y) = x : unapplyFun y+unapplyFun x = [x] -fold :: a -> (a -> a -> a) -> [a] -> a-fold x f [] = x-fold x f xs = fold1 f xs +fromName :: Name -> String+fromName (Ident x) = x+fromName (Symbol x) = x -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+fromQName :: QName -> 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) = ":"  -halves :: [a] -> ([a],[a])-halves [] = ([], [])-halves (x:xs) = (x:b,a)-    where (a,b) = halves xs+fromTyVarBind :: TyVarBind -> Name+fromTyVarBind (KindedVar x _) = x+fromTyVarBind (UnkindedVar x) = x +declNames :: Decl -> [String]+declNames x = map fromName $ case x of+    TypeDecl _ name _ _ -> [name]+    DataDecl _ _ _ name _ _ _ -> [name]+    GDataDecl _ _ _ name _ _ _ _ -> [name]+    TypeFamDecl _ name _ _ -> [name]+    DataFamDecl _ _ name _ _ -> [name]+    ClassDecl _ _ name _ _ _ -> [name]+    TypeSig _ names _ -> names+    _ -> [] -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+isTypeSig :: Decl -> Bool+isTypeSig TypeSig{} = True+isTypeSig _ = False  -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+tarballReadFiles :: FilePath -> IO [(FilePath, LBS.ByteString)]+tarballReadFiles file = f . Tar.read . GZip.decompress <$> LBS.readFile file+    where+        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  -merges :: Ord a => [[a]] -> [a]-merges = fold [] merge+-- | 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] -mergesBy :: (a -> a -> Ordering) -> [[a]] -> [a]-mergesBy f = fold [] (mergeBy f)+-- | Only guarantees to be the inverse of escapeHTML+unescapeHTML :: String -> String+unescapeHTML ('&':xs)+    | Just xs <- stripPrefix "lt;" xs = '<' : unescapeHTML xs+    | Just xs <- stripPrefix "gt;" xs = '>' : unescapeHTML xs+    | Just xs <- stripPrefix "amp;" xs = '&' : unescapeHTML xs+    | Just xs <- stripPrefix "quot;" xs = '\"' : unescapeHTML xs+unescapeHTML (x:xs) = x : unescapeHTML xs+unescapeHTML [] = [] +innerTextHTML :: String -> String+innerTextHTML ('<':xs) = innerTextHTML $ drop 1 $ dropWhile (/= '>') xs+innerTextHTML (x:xs) = x : innerTextHTML xs+innerTextHTML [] = [] -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+isUpper1 (x:xs) = isUpper x+isUpper1 _ = False +isAlpha1 (x:xs) = isAlpha x+isAlpha1 [] = False -rep from to x = if x == from then to else x-reps from to = map (rep from to)+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 +joinPair :: [a] -> ([a], [a]) -> [a]+joinPair sep (a,b) = a ++ sep ++ b --- | 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+testing_, testing :: String -> IO () -> IO ()+testing_ name act = do putStr $ "Test " ++ name ++ " "; act+testing name act = do testing_ name act; putStrLn ""++testEq :: (Show a, Eq a) => a -> a -> IO ()+testEq a b | a == b = putStr "."+           | otherwise = errorIO $ "Expected equal, but " ++ show a ++ " /= " ++ show b++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-        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+        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) ' ' -rbreak f xs = case break f $ reverse xs of-    (_, []) -> (xs, [])-    (as, b:bs) -> (reverse bs, b:reverse as) +tag :: String -> [String] -> String -> String+tag name attr inner = "<" ++ unwords (name : map f attr) ++ ">" ++ inner ++ "</" ++ name ++ ">"+    where f (break (== '=') -> (a,'=':b)) = a ++ "=\"" ++ escapeHTML b ++ "\""+          f x = x -compareCaseless :: String -> String -> Ordering-compareCaseless x = compare (map toLower x) . map toLower+tag_ :: String -> String -> String+tag_ name = tag name []  --- 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+-- 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; error msg+        Right v -> do evaluate $ rnf v; return v +-- I would like to use the storable-tuple package, but it's not in Stackage+instance forall a b . (Storable a, Storable b) => Storable (a,b) where+    sizeOf x = sizeOf (fst x) + sizeOf (snd x)+    alignment x = alignment (fst x) `max` alignment (snd x) -- dodgy, but enough for my purposes+    peekByteOff ptr pos = liftM2 (,) (peekByteOff ptr pos) (peekByteOff ptr $ pos + sizeOf (undefined :: a))+    pokeByteOff ptr pos (a,b) = pokeByteOff ptr pos a >> pokeByteOff ptr (pos + sizeOf (undefined :: a)) b -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 +data Average a = Average !a !Int deriving Show -- a / b -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+toAverage :: a -> Average a+toAverage x = Average x 1 -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)+fromAverage :: Fractional a => Average a -> a+fromAverage (Average a b) = a / fromIntegral b++instance Num a => Monoid (Average a) where+    mempty = Average 0 0+    mappend (Average x1 x2) (Average y1 y2) = Average (x1+y1) (x2+y2)+++readMaybe :: Read a => String -> Maybe a+readMaybe s | [x] <- [x | (x,t) <- reads s, ("","") <- lex t] = Just x+            | otherwise = Nothing+++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 :: String -> URL+hackagePackageURL x = "https://hackage.haskell.org/package/" ++ x++hackageModuleURL :: String -> URL+hackageModuleURL x = "/docs/" ++ ghcModuleURL x++ghcModuleURL :: String -> URL+ghcModuleURL x = replace "." "-" 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+++-- | 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 = Map.insert (fst x) (snd x) mp+++general_util_test :: IO ()+general_util_test = do+    testing "General.Util.splitPair" $ do+        let a === b = if a == b then putChar '.' else error $ 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
src/General/Web.hs view
@@ -1,196 +1,95 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE PatternGuards #-}-{-# OPTIONS_GHC -fno-warn-unused-imports #-} -- becomes confusing with all the CPP--{- |-    General web utility functions.--}+{-# LANGUAGE ScopedTypeVariables, OverloadedStrings, CPP, ViewPatterns, RecordWildCards #-}  module General.Web(-    responseOK, responseNotFound,-    responseFlatten, responseEvaluate, responseRewrite,-    URL, filePathToURL, combineURL, escapeURL, (++%), unescapeURL,-    escapeHTML, (++&), htmlTag,-    Args, cgiArgs, cgiResponse, parseHttpQueryArgs+    Input(..), Output(..), readInput, server     ) where -#ifndef MIN_VERSION_wai-#define MIN_VERSION_wai(a,b,c) 1+-- #define PROFILE++-- For some reason, profiling stops working if I import warp+-- Tracked as https://github.com/yesodweb/wai/issues/311+#ifndef PROFILE+import Network.Wai.Handler.Warp hiding (Port, Handle)+import Network.Wai.Handler.WarpTLS #endif -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.Status+import qualified Data.Text as Text+import General.Str+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 [] = []---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) ""----- | Escape the second argument as a CGI query string before appending-(++%) :: String -> String -> String-a ++% b = a ++ escapeURL b-------------------------------------------------------------------------- CGI STUFF---- 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"---cgiArgs :: IO (Maybe Args)-cgiArgs = do-    x <- cgiVariable-    return $ case x of-        Nothing -> Nothing-        Just y -> Just $ parseHttpQueryArgs $ ['=' | '=' `notElem` y] ++ y+import Data.List.Extra+import Data.String+import Data.Tuple.Extra+import Data.Monoid+import System.FilePath+import Control.Exception.Extra+import System.Time.Extra+import General.Log+import Network.URI  -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]+data Input = Input+    {inputURL :: [String]+    ,inputArgs :: [(String, String)]+    } deriving Show +readInput :: String -> Input+readInput (breakOn "?" -> (a,b)) = Input (dropWhile null $ splitOn "/" a) $+    map (second (unEscapeString . drop1) . breakOn "=") $ splitOn "&" $ drop1 b ------------------------------------------------------------------------- HTTP STUFF+data Output+    = OutputString LBS.ByteString+    | OutputHTML LBS.ByteString+    | OutputJSON LBS.ByteString+    | OutputFail LBS.ByteString+    | OutputFile FilePath+      deriving Show -parseHttpQueryArgs :: String -> Args-parseHttpQueryArgs xs = mapMaybe (f . splitPair "=") $ splitList "&" xs-    where f Nothing = Nothing-          f (Just (a,b)) = Just (unescapeURL a, unescapeURL b)+instance NFData Output where+    rnf (OutputString x) = rnf x+    rnf (OutputJSON x) = rnf x+    rnf (OutputHTML x) = rnf x+    rnf (OutputFail x) = rnf x+    rnf (OutputFile x) = rnf x  -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-+server :: Log -> CmdLine -> (Input -> IO Output) -> IO ()+#ifdef PROFILE+server _ _ _ = return ()+#else+server log Server{..} act = do+    logAddMessage log $ "Server started on port " ++ show port+    let+        host' = fromString $ if local then "127.0.0.1" 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+    runServer $ \req reply -> do+        putStrLn $ BS.unpack $ rawPathInfo req <> rawQueryString req+        let pay = Input (map Text.unpack $ pathInfo req)+                        [(strUnpack a, maybe "" strUnpack b) | (a,b) <- queryString req]+        (time,res) <- duration $ try_ $ do s <- act pay; evaluate $ rnf s; return s+        res <- either (fmap Left . showException) (return . Right) res+        logAddEntry log (showSockAddr $ remoteHost req)+            (BS.unpack $ rawPathInfo req <> rawQueryString req) time (either Just (const Nothing) res)+        case res of+            Left s -> reply $ responseLBS status500 [] $ LBS.pack s+            Right v -> reply $ case v of+                OutputFile file -> responseFile status200+                    [("content-type",c) | Just c <- [lookup (takeExtension file) contentType]] file Nothing+                OutputString msg -> responseLBS status200 [] msg+                OutputJSON msg -> responseLBS status200 [("content-type", "application/json"), ("access-control-allow-origin", "*")] msg+                OutputFail msg -> responseLBS status500 [] msg+                OutputHTML msg -> responseLBS status200 [("content-type","text/html")] msg -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+contentType = [(".html","text/html"),(".css","text/css"),(".js","text/javascript")]+#endif
src/Hoogle.hs view
@@ -1,176 +1,44 @@ --- | 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,+    Target(..), URL,+    hoogle     ) 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")---mergeDatabase :: [FilePath] -> FilePath -> IO ()-mergeDatabase src out = do-    x <- mapM loadDatabase src-    saveDatabase out $ mconcat x----- | 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)]---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-+import Control.DeepSeq (NFData) --- Hoogle.Query+import Query+import Input.Item+import General.Util+import General.Store --- | 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+import Action.CmdLine+import Action.Generate+import Action.Search+import Action.Server+import Action.Test  --- 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)+-- | Database containing Hoogle search data.+newtype Database = Database StoreRead -toResult :: H.Result -> (Score,Result)-toResult r@(H.Result ent view score) = (score, Result parents self docs)-    where-        self = H.renderResult r+-- | Load a database from a file.+withDatabase :: NFData a => FilePath -> (Database -> IO a) -> IO a+withDatabase file act = storeReadFile file $ act . Database -        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,140 @@+{-# LANGUAGE ViewPatterns, PatternGuards, TupleSections, RecordWildCards, ScopedTypeVariables #-}++-- | Module for reading Cabal files.+module Input.Cabal(+    Package(..),+    parseCabalTarball, readGhcPkg,+    packagePopularity+    ) where++import Input.Settings++import Data.List.Extra+import System.FilePath+import Control.DeepSeq+import Control.Exception+import Control.Monad+import System.IO.Extra+import General.Str+import System.Process+import System.Directory+import Data.Char+import Data.Maybe+import Data.Tuple.Extra+import qualified Data.Text as T+import qualified Data.Map.Strict as Map+import General.Util+import General.Conduit+import Data.Monoid+import Control.Applicative+import Prelude++---------------------------------------------------------------------+-- DATA TYPE++-- | A representation of a Cabal package.+data Package = Package+    {packageTags :: [(T.Text, T.Text)] -- ^ 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 :: T.Text -- ^ The synposis, grabbed from the top section.+    ,packageVersion :: T.Text -- ^ The version, grabbed from the top section.+    ,packageDepends :: [T.Text] -- ^ The list of packages that this package directly depends on.+    ,packageDocs :: Maybe FilePath -- ^ Directory where the documentation is located+    } deriving Show++instance Monoid Package where+    mempty = Package [] True T.empty T.empty [] Nothing+    mappend (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 T.null a then b else a++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 String Package -> ([String], Map.Map String Int)+packagePopularity cbl = (errs, Map.map length good)+    where+        errs =  [ user ++ ".cabal: Import of non-existant package " ++ 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 (++) [(T.unpack 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 String Package)+readGhcPkg settings = do+    topdir <- findExecutable "ghc-pkg"+    stdout <- readProcess "ghc-pkg" ["dump"] ""+    let g (stripPrefix "$topdir" -> Just x) | Just t <- topdir = takeDirectory t ++ x+        g x = x+    let fixer p = p{packageLibrary = True, packageDocs = g <$> packageDocs p}+    let f ((stripPrefix "name: " -> Just x):xs) = Just (x, fixer $ readCabal settings $ unlines xs)+        f xs = Nothing+    return $ Map.fromList $ mapMaybe f $ splitOn ["---"] $ lines stdout+++-- | Given a tarball of Cabal files, parse the latest version of each package.+parseCabalTarball :: Settings -> FilePath -> IO (Map.Map String Package)+-- items are stored as:+-- QuickCheck/2.7.5/QuickCheck.cabal+-- QuickCheck/2.7.6/QuickCheck.cabal+-- rely on the fact the highest version is last (using lastValues)+parseCabalTarball settings tarfile = do+    res <- runConduit $+        (sourceList =<< liftIO (tarballReadFiles tarfile)) =$=+        mapC (first takeBaseName) =$= groupOnLastC fst =$= mapMC (\x -> do evaluate $ rnf x; return x) =$=+        pipelineC 10 (mapC (second $ readCabal settings . lstrUnpack) =$= mapMC (\x -> do evaluate $ rnf x; return x) =$= sinkList)+    return $ Map.fromList res+++---------------------------------------------------------------------+-- PARSERS++-- | Cabal information, plus who I depend on+readCabal :: Settings -> String -> Package+readCabal Settings{..} src = Package{..}+    where+        mp = Map.fromListWith (++) $ lexCabal src+        ask x = Map.findWithDefault [] x mp++        packageDepends =+            map T.pack $ nubOrd $ filter (/= "") $+            map (intercalate "-" . takeWhile (all isAlpha . take 1) . splitOn "-" . fst . word1) $+            concatMap (split (== ',')) (ask "build-depends") ++ concatMap words (ask "depends")+        packageVersion = T.pack $ head $ dropWhile null (ask "version") ++ ["0.0"]+        packageSynopsis = T.pack $ unwords $ words $ unwords $ ask "synopsis"+        packageLibrary = "library" `elem` map (lower . trim) (lines src)+        packageDocs = listToMaybe $ ask "haddock-html"++        packageTags = map (both T.pack) $ nubOrd $ concat+            [ map (head xs,) $ concatMap cleanup $ concatMap ask xs+            | xs <- [["license"],["category"],["author","maintainer"]]]++        -- 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` ",&")+++-- Ignores nesting beacuse it's not interesting for any of the fields I care about+lexCabal :: String -> [(String, [String])]+lexCabal = f . lines+    where+        f (x:xs) | (white,x) <- span isSpace x+                 , (name@(_:_),x) <- span (\c -> isAlpha c || c == '-') x+                 , ':':x <- trim x+                 , (xs1,xs2) <- span (\s -> length (takeWhile isSpace s) > length white) xs+                 = (lower name, trim x : replace ["."] [""] (map (trim . fst . breakOn "--") xs1)) : f xs2+        f (x:xs) = f xs+        f [] = []
+ src/Input/Download.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE TupleSections #-}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- Use conduitManagerSettings to work with http-conduit-2.1.6 and below++module Input.Download(downloadInput) where++import System.FilePath+import Control.Monad.Extra+import System.Directory+import Data.Conduit.Binary (sinkFile)+import qualified Network.HTTP.Conduit as C+import Network.Connection+import qualified Data.Conduit as C+import General.Util+import General.Timing+import Network+import Control.Monad.Trans.Resource+++-- | Download all the input files to input/+downloadInput :: Timing -> Bool -> Maybe Bool -> FilePath -> String -> URL -> IO FilePath+downloadInput timing insecure download dir name url = do+    let file = dir </> "input-" ++ name+    exists <- doesFileExist file+    when (not exists && download == Just False) $+        error $ "File is not already downloaded and --download=no given, downloading " ++ url ++ " to " ++ file+    when (not exists || download == Just True) $+        timed timing ("Downloading " ++ url) $ do+            downloadFile insecure (file <.> "part") url+            renameFile (file <.> "part") file+    return file++downloadFile :: Bool -> FilePath -> String -> IO ()+downloadFile insecure file url = withSocketsDo $ do+    request <- C.parseUrl url+    manager <- C.newManager $ C.mkManagerSettings (TLSSettingsSimple insecure False False) Nothing+    runResourceT $ do+        response <- C.http request manager+        C.responseBody response C.$$+- sinkFile file
+ src/Input/Haddock.hs view
@@ -0,0 +1,191 @@+{-# LANGUAGE ViewPatterns, PatternGuards, TupleSections, OverloadedStrings, Rank2Types, DeriveDataTypeable #-}++module Input.Haddock(parseHoogle, fakePackage, input_hoogle_test) where++import Language.Haskell.Exts as HSE+import Data.Char+import Data.List.Extra+import Data.Data+import Input.Item+import General.Util+import Control.DeepSeq+import Control.Monad.Trans.Class+import General.Conduit+import Control.Monad.Extra+import General.Str+++-- | An entry in the Hoogle DB+data Entry = EPackage String+           | EModule String+           | EDecl Decl+             deriving (Data,Typeable,Show)+++fakePackage :: String -> 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 -> LStr -> Producer m (Maybe Target, [Item])+parseHoogle warning url body = sourceLStr body =$= linesCR =$= zipFromC 1 =$= parserC warning =$= hierarchyC url =$= mapC (\x -> rnf x `seq` x)++parserC :: Monad m => (String -> m ()) -> Conduit (Int, Str) m (Target, Entry)+parserC warning = f [] ""+    where+        f com url = do+            x <- await+            whenJust x $ \(i,s) -> case () of+                _ | Just s <- strStripPrefix "-- | " s -> f [s] url+                  | Just s <- strStripPrefix "--" s -> f (if null com then [] else strTrimStart s : com) url+                  | Just s <- strStripPrefix "@url " s -> f com (strUnpack s)+                  | strNull $ strTrimStart s -> f [] ""+                  | otherwise -> do+                        case parseLine $ fixLine $ strUnpack 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{}] -> return () -- 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 [] ""++typeItem (EPackage x) = "package"+typeItem (EModule x) = "module"+typeItem _ = ""+++-- FIXME: used to be in two different modules, now does and then undoes lots of stuff+reformat :: [Str] -> String+reformat = unlines . map strUnpack+++hierarchyC :: Monad m => URL -> Conduit (Target, Entry) m (Maybe Target, [Item])+hierarchyC packageUrl = void $ mapAccumC f (Nothing, Nothing)+    where+        f (pkg, mod) (t, EPackage x) = ((Just (x, url), Nothing), (Just t{targetURL=url}, [IPackage x]))+            where url = targetURL t `orIfNull` packageUrl+        f (pkg, mod) (t, EModule x) = ((pkg, Just (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 x = "<b>package</b> <span class=name><0>" ++ escapeHTML x ++ "</0></span>"+renderModule (breakEnd (== '.') -> (pre,post)) = "<b>module</b> " ++ escapeHTML pre ++ "<span class=name><0>" ++ escapeHTML post ++ "</0></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 (tail post)+            else+                escapeHTML pre ++ name (highlight now) ++ escapeHTML post+        focus (EDecl x) = pretty x++        highlight :: String -> String+        highlight x = "<0>" ++ escapeHTML x ++ "</0>"+++parseLine :: String -> Either String [Entry]+parseLine x@('@':str) = case a of+        "package" | [b] <- words b, b /= "" -> Right [EPackage b]+        "version" -> Right []+        _ -> Left $ "unknown attribute: " ++ x+    where (a,b) = word1 str+parseLine (stripPrefix "module " -> Just x) = Right [EModule 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+fixLine x | "class " `isPrefixOf` x = fst $ breakOn " where " x+fixLine x = x+++readItem :: String -> Maybe Decl+readItem x | ParseOk y <- myParseDecl x = Just $ unGADT y+readItem x -- newtype+    | Just x <- stripPrefix "newtype " x+    , ParseOk (DataDecl a _ c d e f g) <- fmap unGADT $ myParseDecl $ "data " ++ x+    = Just $ DataDecl a NewType c d e f g+readItem x -- constructors+    | ParseOk (GDataDecl _ _ _ _ _ _ [GadtDecl s name _ ty] _) <- myParseDecl $ "data Data where " ++ x+    , let f (TyBang _ (TyParen x@TyApp{})) = x+          f (TyBang _ x) = x+          f x = x+    = Just $ TypeSig s [name] $ applyFun1 $ map f $ unapplyFun ty+readItem ('(':xs) -- tuple constructors+    | (com,')':rest) <- span (== ',') xs+    , ParseOk (TypeSig s [Ident _] ty) <- myParseDecl $ replicate (length com + 2) 'a' ++ rest+    = Just $ TypeSig s [Ident $ '(':com++")"] ty+readItem (stripPrefix "data (" -> Just xs)  -- tuple data type+    | (com,')':rest) <- span (== ',') xs+    , ParseOk (DataDecl a b c _ e f g) <- fmap unGADT $ myParseDecl $+        "data " ++ replicate (length com + 2) 'A' ++ rest+    = Just $ DataDecl a b c (Ident $ '(':com++")") e f g+readItem _ = Nothing++myParseDecl = parseDeclWithMode parseMode -- partial application, to share the initialisation cost++unGADT (GDataDecl a b c d e _ [] f) = DataDecl a b c d e [] f+unGADT x = x++prettyItem :: Entry -> String+prettyItem (EPackage x) = "package " ++ x+prettyItem (EModule x) = "module " ++ x+prettyItem (EDecl x) = pretty x+++input_hoogle_test :: IO ()+input_hoogle_test = testing "Input.Hoogle.parseLine" $ do+    let a === b | fmap (map prettyItem) (parseLine a) == Right [b] = putChar '.'+                | otherwise = error $ 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)"+    test "data (,,) a b"+    test "reverse :: [a] -> [a]"+    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"+    -- Broken in the last HSE release, fixed in HSE HEAD+    -- test "quotRemInt# :: Int# -> Int# -> (# Int#, Int# #)"+    test "( # ) :: Int"
+ src/Input/Item.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, DeriveFunctor #-}+{-# LANGUAGE RecordWildCards, OverloadedStrings, PatternGuards, ScopedTypeVariables #-}++-- | Types used to generate the input.+module Input.Item(+    Sig(..), Ctx(..), Ty(..), prettySig,+    Item(..), itemName,+    Target(..), targetExpandURL, TargetId(..),+    splitIPackage, splitIModule,+    hseToSig, hseToItem+    ) 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.IString+import Prelude+import Data.Aeson.Types+import qualified Data.Text as T+---------------------------------------------------------------------+-- 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 String+    | IModule String+    | IName String+    | ISignature (Sig IString)+    | IAlias String [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) = rnf x+    rnf (ISignature x) = rnf x+    rnf (IAlias a b c) = rnf (a,b,c)+    rnf (IInstance a) = rnf a++itemName :: Item -> Maybe String+itemName (IPackage x) = Just 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 <0> for the name and <1> 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" :: T.Text, toJSON a),+      ("package" :: T.Text, maybeNamedURL b),+      ("module" :: T.Text, maybeNamedURL c),+      ("type" :: T.Text, toJSON d),+      ("item" :: T.Text, toJSON e),+      ("docs" :: T.Text, toJSON f)+      ]+      where+        maybeNamedURL m = maybe emptyObject namedURL m+        namedURL (name, url) = object [("name" :: T.Text, toJSON name), ("url" :: T.Text, toJSON url)]+++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+++splitIPackage, splitIModule :: [(a, Item)] -> [(String, [(a, Item)])]+splitIPackage = splitUsing $ \x -> case snd x of IPackage x -> Just x; _ -> Nothing+splitIModule = splitUsing $ \x -> case snd x of IModule x -> Just x; _ -> Nothing++splitUsing :: (a -> Maybe String) -> [a] -> [(String, [a])]+splitUsing f = repeatedly $ \(x:xs) ->+    let (a,b) = break (isJust . f) xs+    in ((fromMaybe "" $ f x, x:a), b)+++---------------------------------------------------------------------+-- HSE CONVERSION++hseToSig :: Type -> 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 (concatMap ctx 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 box ts) = TCon (fromQName $ Special $ TupleCon 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 a b c) = ty $ TyCon b `TyApp` a `TyApp` c+        ty (TyKind x _) = ty x+        ty (TyBang _ x) = ty x+        ty (TyParen x) = ty x+        ty _ = TVar "_" []++        ctx (ParenA x) = ctx x+        ctx (InfixA a con b) = ctx $ ClassA con [a,b]+        ctx (ClassA con (TyVar var:_)) = [Ctx (fromQName con) (fromName var)]+        ctx _ = []+++hseToItem :: Decl -> [Item]+hseToItem (TypeSig _ names ty) = ISignature (toIString <$> hseToSig ty) : map (IName . fromName) names+hseToItem (TypeDecl _ name bind rhs) = [IAlias (fromName name) (map (toIString . fromName . fromTyVarBind) bind) (toIString <$> hseToSig rhs)]+hseToItem (InstDecl _ _ _ ctx name args _) = [IInstance $ fmap toIString $ hseToSig $ TyForall Nothing ctx $ applyType (TyCon name) args]+hseToItem x = map IName $ declNames x
+ src/Input/Reorder.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE RecordWildCards #-}++module Input.Reorder(reorderItems) where++import Input.Item+import Input.Settings+import Data.List.Extra+import Data.Tuple.Extra+++-- | Reorder items so the most popular ones are first, using reverse dependencies+reorderItems :: Settings -> (String -> Int) -> [(a, Item)] -> [(a, Item)]+reorderItems Settings{..} packageOrder xs =+    concatMap snd $ sortOn ((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) &&& id) . fst) $ refunc $ splitIModule xs)+            where f = reorderModule x
+ src/Input/Set.hs view
@@ -0,0 +1,31 @@+{-# 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 . delete "telegram-api" . f . lines <$> readFile' file+    where+        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+    return $ 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,88 @@+{-# LANGUAGE RecordWildCards, PatternGuards, TemplateHaskell #-}+++-- | Module for reading settings files.+module Input.Settings(+    Settings(..), loadSettings+    ) where++import Control.Exception (catch, throwIO)+import Data.List.Extra+import Data.Maybe+import 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 return backup+            else throwIO e+    return $ concat $ zipWith 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+    let backup = $(runIO (readFileUTF8 "misc/settings.txt") >>= lift)+    src <- readFileSettings (dataDir </> "misc/settings.txt") backup+    return $ 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 -> last $ 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 -> (Conduit (Maybe Target, item) IO (Maybe TargetId, item) -> IO a) -> IO a+writeItems store act = act $ do+    void $ (\f -> mapAccumMC f 0) $ \pos (target, item) -> case target of+        Nothing -> return (pos, (Nothing, item))+        Just target -> do+            let bs = LBS.toStrict $ GZip.compress $ lstrPack $ unlines $ outputItem target+            liftIO $ do+                storeWritePart store Items $ intToBS $ BS.length bs+                storeWritePart store Items bs+            let pos2 = pos + fromIntegral (intSize + BS.length bs)+            return (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 $ return $ 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 = BS.intercalate (BS.pack "\0") (map strPack strs) `BS.append` BS.pack "\0\0"+    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 "." x]+itemNamePart x = maybeToList $ 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 return $ V.toList vs else do+        let tweak x = strPack $ [' ' | 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+                        return $ 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,163 @@+{-# LANGUAGE ViewPatterns, TupleSections, ScopedTypeVariables, DeriveDataTypeable, PatternGuards, GADTs #-}++module Output.Tags(writeTags, completionTags, applyTags) where++import Data.Function+import Data.List.Extra+import Data.Tuple.Extra+import Data.Maybe+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++---------------------------------------------------------------------+-- DATA TYPE++-- matches (a,b) if i >= a && i <= b++data Packages a where Packages :: Packages (Str0, 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 (Str0, 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 (Str0, 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 Str0 deriving Typeable+    -- a list of things to complete to, interspersed with \0+++writeTags :: StoreWrite -> (String -> Bool) -> (String -> [(String,String)]) -> [(Maybe TargetId, Item)] -> IO ()+writeTags store keep extra xs = do+    let splitPkg = splitIPackage xs+    let packages = addRange splitPkg+    storeWrite store Packages (join0 $ map fst packages, V.fromList $ map snd packages)++    let categories = map (first snd . second reverse) $ Map.toList $ Map.fromListWith (++)+            [(((weightTag ex, both lower ex), joinPair ":" ex),[rng]) | (p,rng) <- packages, ex <- extra p]+    storeWrite store Categories (join0 $ map fst categories, jaggedFromList $ map snd categories)++    let modules = addRange $ concatMap (splitIModule . snd) splitPkg+    storeWrite store Modules (join0 $ map (lower . fst) modules, V.fromList $ map snd modules)++    storeWrite store Completions $ join0 $+        takeWhile ("set:" `isPrefixOf`) (map fst categories) +++        map ("package:"++) (sortOn lower $ 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 :: [(String, [(Maybe TargetId,a)])] -> [(String, (TargetId, TargetId))]+        addRange xs = [(a, (minimum' is, maximum' is)) | (a,b) <- xs, let is = mapMaybe fst b, 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 $ split0 $ 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", v ~~ "exact" = Just IsExact+    | k ~~ "is", v ~~ "package" = Just IsPackage+    | k ~~ "is", v ~~ "module" = Just IsModule+    | k ~~ "package", v /= "" = Just $ EqPackage v+    | k ~~ "module", v /= "" = 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+resolveTag :: StoreRead -> Tag -> (Maybe Tag, [(TargetId,TargetId)])+resolveTag store x = case x of+    IsExact -> (Just IsExact, [])+    IsPackage -> (Just IsPackage, map (dupe . fst) $ V.toList packageIds)+    IsModule -> (Just IsModule, map (dupe . fst) $ V.toList moduleIds)+    EqPackage (BS.pack . lower -> 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) <- zip [0..] $ split0 packageNames, val `BS.isPrefixOf` x]+            -> let (i,x) = snd $ minimumBy (compare `on` fst) res in (Just $ EqPackage $ BS.unpack x, [packageIds V.! i])+        | otherwise -> (Nothing, [])+    EqModule x -> (Just $ EqModule x, map (moduleIds V.!) $ findIndices (eqModule $ lower x) $ split0 moduleNames)+    EqCategory cat val -> (Just $ EqCategory cat val, concat+        [ V.toList $ jaggedAsk categoryIds i+        | i <- elemIndices (BS.pack (cat ++ ":" ++ val)) $ split0 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) && (null pos || posq i)+    where (posq,negq) = both inRanges (pos,neg)+          (pos, neg) = both (map snd) $ partition fst $ concatMap f qs+          f (QueryScope sense cat val) = map (sense,) $ maybe [] (snd . resolveTag ts) $ parseTag cat val+++-- | 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 [] (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 _ = map fst $ snd $ resolveTag ts IsPackage
+ src/Output/Types.hs view
@@ -0,0 +1,333 @@+{-# LANGUAGE ViewPatterns, TupleSections, RecordWildCards, ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, BangPatterns, GADTs #-}++module Output.Types(writeTypes, searchTypes, searchTypesDebug) 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 qualified Data.Map.Strict as Map+import qualified Data.ByteString.Char8 as BS+import qualified Data.Vector.Storable as V+import qualified Data.Vector.Storable.Mutable as VM+import Data.Binary+import Data.Maybe+import Data.List.Extra+import Data.Tuple.Extra+import Data.Generics.Uniplate.Data+import Data.Data+import System.FilePath+import System.IO.Extra+import Control.Monad.Extra+import Foreign.Storable+import Control.Applicative+import Numeric.Extra+import Prelude++import Input.Item+import General.Store+import General.IString+import General.Util+++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 <- return $ 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 <- return $ map (lookupNames names (error "Unknown name in writeTypes")) xs+    writeFingerprints store xs+    writeSignatures store xs+++searchTypes :: StoreRead -> Sig String -> [TargetId]+searchTypes store q =+        concatMap (expandDuplicates $ readDuplicates store) $+        searchFingerprints store names 100 $+        lookupNames names name0 q+        -- map unknown fields to name0, i.e. _+    where+        names = readNames store+++searchTypesDebug :: StoreRead -> (String, Sig String) -> [(String, Sig String)] -> [String]+searchTypesDebug store query answers = intercalate [""] $+    f False "Query" query : zipWith (\i -> f True ("Answer " ++ show i)) [1..] answers+    where+        qsig = lookupNames names name0 $ 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 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 (BS.ByteString, V.Vector Name) deriving Typeable++-- 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 Word16 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 :: Word16)++newtype Names = Names {lookupName :: String -> Maybe Name}++lookupNames :: Names -> Name -> Sig String -> Sig Name+lookupNames Names{..} def (Sig ctx typ) = Sig (map f ctx) (map g typ)+    where+        vars = nubOrd $ "_" : [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 $ '~':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 String Int -> [Sig String] -> IO Names+writeNames store debug inst xs = do+    let sigNames (Sig ctx typ) = nubOrd ['~':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 String Int = -- how many times each identifier occurs+            Map.unionWith (\typ sig -> sig + min sig typ) (Map.mapKeysMonotonic ('~':) inst) $+            Map.fromListWith (+) $ map (,1::Int) $ concatMap sigNames xs+    let names = spreadNames $ Map.toList freq+    debug "names" $ unlines [s ++ " = " ++ show n ++ " (" ++ show (freq Map.! s) ++ " uses)" | (s,n) <- names]+    names <- return $ sortOn fst names+    storeWrite store TypesNames (BS.pack $ intercalate "\0" $ map fst names, V.fromList $ map snd names)+    let mp2 = Map.fromAscList names+    return $ 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 (reverse . sortOn 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"++        -- I can only assign values between mn and mx inclusive+        f :: Word16 -> Word16 -> [(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 (BS.pack x) mp+    where mp = Map.fromAscList $ zip (BS.split '\0' 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 <- return $ 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)) <- zip [0::Int ..] xs]+    -- give a list of TargetId's at each index+    storeWrite store TypesDuplicates $ jaggedFromList $ map (reverse . snd) xs+    return $ 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 _ = 64+    alignment _ = 4+    peekByteOff ptr i = Fingerprint+        <$> peekByteOff ptr (i+0) <*> peekByteOff ptr (i+2) <*> peekByteOff ptr (i+4)+        <*> peekByteOff ptr (i+6) <*> peekByteOff ptr (i+7)+    pokeByteOff ptr i Fingerprint{..} = do+        pokeByteOff ptr (i+0) fpRare1 >> pokeByteOff ptr (i+2) fpRare2 >> pokeByteOff ptr (i+4) fpRare3+        pokeByteOff ptr (i+6) fpArity >> pokeByteOff ptr (i+7) fpTerms++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 - 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 - 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") $ floor rare -- should this be common?+                              | otherwise = let p = popularityName n in mfpCost ("term " ++ prettyName n ++ " (" ++ showDP 2 p ++ ") missing") $+                                            floor $ (p*common) + ((1-p)*rare)+++searchFingerprints :: StoreRead -> Names -> Int -> Sig Name -> [Int]+searchFingerprints store names n sig = map snd $ takeSortOn fst n [(v, i) | (i,f) <- zip [0..] fs, Just v <- [test f]]+    where fs = V.toList $ storeRead store TypesFingerprints :: [Fingerprint]+          test = matchFingerprint sig+++---------------------------------------------------------------------+-- 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_ (zip [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
+ src/Query.hs view
@@ -0,0 +1,239 @@+{-# LANGUAGE PatternGuards, ViewPatterns, RecordWildCards #-}++module Query(+    Query(..), isQueryName, isQueryType, isQueryScope,+    parseQuery, renderQuery,+    query_test+    ) where++import Data.List+import Language.Haskell.Exts+import Data.Char+import Data.List.Extra+import Data.Generics.Uniplate.Data+import General.Util+import Data.Maybe+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] -> String+renderQuery [] = "<i>No query</i>"+renderQuery xs = unwords $+    [escapeHTML x | QueryName x <- xs] +++    [":: " ++ escapeHTML (pretty x) | QueryType x <- xs] +++    [['-' | not scopeInclude] ++ escapeHTML scopeCategory ++ ":" ++ escapeHTML scopeValue | QueryScope{..} <- xs] +++    ["<strike>" ++ escapeHTML x ++ "</strike>" | 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 = "(),;[]`{}\"'"+          ascSymbol = "!#$%&*+./<=>?@\\^|-~"++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 (dropWhile isSpace xs)+    | isAlpha x || x == '_' = let (a,b) = span (\x -> isAlphaNum x || x `elem` "_'#-") xs in (x:a) : lexer 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) 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 . 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)"+    "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 ++ "$"