hoogle-4.2.43/0000755000000000000000000000000012623347442011256 5ustar0000000000000000hoogle-4.2.43/Setup.hs0000644000000000000000000000005612623347442012713 0ustar0000000000000000import Distribution.Simple main = defaultMain hoogle-4.2.43/README.md0000644000000000000000000002020612623347442012535 0ustar0000000000000000# Hoogle [![Hackage version](https://img.shields.io/hackage/v/hoogle.svg?style=flat)](https://hackage.haskell.org/package/hoogle) [![Build Status](https://img.shields.io/travis/ndmitchell/hoogle.svg?style=flat)](https://travis-ci.org/ndmitchell/hoogle) **NOTE: This code branch contains the code for the Hoogle v4 series. The `master` branch contains the code for the current Hoogle v5 series.** Hoogle 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 * **Source code:** http://github.com/ndmitchell/hoogle * **Bug tracker:** http://code.google.com/p/ndmitchell/issues/list ## Hoogle Use Hoogle can be used in several ways: * **Online**, with the web interface at http://haskell.org/hoogle * **In [IRC](http://haskell.org/haskellwiki/Haskell_IRC_channel)**, using the [Lambdabot](http://haskell.org/haskellwiki/Lambdabot) plugin with `@hoogle` and `@hoogle+` * **[Installed locally](docs/Local-Install.md)**, with either a command line or in a browser * **[As a developer](docs/Developers.md)**, through Haskell or JSON APIs. # Searches ## Searching Here are some example searches: * `map` searches as text, finding `map`, `concatMap`, `mapM` * `con map` searches for the text "map" and "con" finding `concatMap`, but not `map` * `a -> a` searches by type, finding `id :: a -> a` * `a` searches for the text "a" * `:: a` searches for the type "a" * `id :: a -> a` searches for the text "id" and the type "a -> a" ## Scope By default, searches look at the [Haskell Platform](http://hackage.haskell.org/platform) and [Haskell keywords](http://haskell.org/haskellwiki/Keywords). However, all [Hackage](http://hackage.haskell.org) packages are available to search. As some examples: * `mode +cmdargs` searches only the "cmdargs" package * `file -base` searches the Haskell Platform, excluding the "base" package * `mode +platform +cmdargs` searches both the Haskell Platform and the "cmdargs" package * `count +missingh` searches only the "MissingH" package - all packages are written in lower-case With the set of packages you are searching, you can also restrict the set of modules searched: * `file -System` excludes results from modules such as `System.IO`, `System.FilePath.Windows` and `Distribution.System` * `fold +Data.Map` finds results in the `Data.Map` module # Integration ## Command Line Version To invoke Hoogle type: hoogle "[a] -> [b]" Note the quotes, otherwise you will redirect the output to the file [b]. To ensure you have data files for the Hackage modules, you will first need to type: hoogle data Which will download and build Hoogle databases. ## Chrome Integration **As a keyword search:** With a keyword search you can type `h map` directly into the location bar to perform a Hoogle search. Go to the [Hoogle website](http://haskell.org/hoogle/) in Chrome, right-click in the Hoogle search field and select "Add as a search engine...". Give it a keyword such as "h". ## Firefox Integration **From the search bar:** Go to the [Hoogle website](http://haskell.org/hoogle/) in Firefox and click on the drop-down arrow at the left of the search bar, and select the "Add Hoogle" option. Click the arrow again to select Hoogle as your search engine. **As a keyword search:** With a keyword search you can type `h map` directly into the location bar to perform a Hoogle search. Go to the [Hoogle website](http://haskell.org/hoogle/) in Firefox, right-click in the Hoogle search field and select "Add a Keyword for this Search...". Given it a keyword such as "h". If you want to search for special symbols in Firefox keyword search, modify the keyword search URL to be: `javascript:window.location.href="http://haskell.org/hoogle?q=" + encodeURIComponent("%s")` ## Firefox Ubiquity Integration [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). # 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. ## Theoretical Foundations A lot of related work was done by Rittri [1] and Runciman [2] in the late 80's. Since then Di Cosmo [3] has produced a book on type isomorphisms. Unfortunately the implementations that accompanied the earlier works were for functional languages that have since become less popular. 1. [Mikael Rittri, Using Types as Search Keys in Function Libraries](http://portal.acm.org/citation.cfm?id=99384). Proceedings of the fourth international conference on Functional Programming languages and Computer Architecture: 174-183, June 1989. 2. [Colin Runciman and Ian Toyn, Retrieving reusable software components by polymorphic type](http://portal.acm.org/citation.cfm?id=99383). Journal of Functional Programming 1 (2): 191-211, April 1991. 3. [Roberto Di Cosmo, Isomorphisms of types: from lambda-calculus to information retrieval and language design](http://www.pps.jussieu.fr/~dicosmo/Publications/ISObook.html). Birkhauser, 1995. ISBN-0-8176-3763-X I have given several presentations on type searching all available from [my home page](http://community.haskell.org/~ndm/hoogle). ## Folders 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 I was unaware of any similar tools before starting development, and no other tool has really influenced this tool (except the first on this list). Some related tools are: * [Google](http://www.google.com/), the leader in online search * [Hayoo](http://holumbus.fh-wedel.de/hayoo/hayoo.html), similar to Hoogle, but with less focus on type search * [Krugle](http://www.krugle.com/), search code, but no Haskell :( ## Acknowledgements All code is all © [Neil Mitchell](http://community.haskell.org/~ndm/), 2004-present. The initial version was done over my summer holiday, and further work was done during my PhD. During Summer 2008 I was funded to full-time on Hoogle by [Google Summer of Code](http://code.google.com/soc/) with the [haskell.org](http://haskell.org/) mentoring organisation. Since then I have been working on Hoogle in my spare time. Various people have given lots of useful ideas, including my PhD supervisor [Colin Runciman](http://www.cs.york.ac.uk/~colin/), and various members of the [Plasma group](http://www.cs.york.ac.uk/plasma/). In addition, the following people have also contributed code or significant debugging work: * [Thomas "Bob" Davie](http://www.cs.kent.ac.uk/people/rpg/tatd2/) * [Don Stewart](http://www.cse.unsw.edu.au/~dons/) * Thomas Jager * [Gaal Yahas](http://gaal.livejournal.com/) * [Mike Dodds](http://www-users.cs.york.ac.uk/~miked/) * [Niklas Broberg](http://www.cs.chalmers.se/~d00nibro/) * Esa Ilari Vuokko * Udo Stenzel * [Henk-Jan van Tuyl](http://members.chello.nl/hjgtuyl/) * Gwern Branwen * Tillmann Rendel * David Waern * Ganesh Sittampalam * Duncan Coutts * Peter Collingbourne * Andrea Vezzosi * Ian Lynagh * [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. hoogle-4.2.43/hoogle.cabal0000644000000000000000000001173212623347442013523 0ustar0000000000000000cabal-version: >= 1.10 build-type: Simple name: hoogle version: 4.2.43 license: BSD3 license-file: docs/LICENSE category: Development author: Neil Mitchell maintainer: Neil Mitchell copyright: Neil Mitchell 2004-2015 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/ bug-reports: https://github.com/ndmitchell/hoogle/issues tested-with: GHC==7.10.1, GHC==7.8.4, GHC==7.6.3 extra-doc-files: README.md CHANGES.txt extra-source-files: datadir/*.txt data-dir: datadir data-files: resources/*.css resources/*.gif resources/*.ico resources/*.js resources/*.png resources/*.html resources/search.xml source-repository head type: git location: https://github.com/ndmitchell/hoogle.git library hs-source-dirs: src default-language: Haskell98 build-depends: base > 4 && < 5, array, containers, directory, filepath, process, random, safe, binary, bytestring >= 0.9, conduit >= 0.2, 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 if !os(mingw32) build-depends: unix 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 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 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-4.2.43/CHANGES.txt0000644000000000000000000001627712623347442013104 0ustar0000000000000000Changelog 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 4.2.38 #96, allow certicate verification failures #95, allow a higher version of Cabal on older GHCs 4.2.37 #94, GHC 7.10 support 4.2.36 #85, add support for missing type constructors 4.2.35 Allow haskell-src-exts-1.16 4.2.34 Add defaultDatabaseLocation 4.2.33 Allow WAI-3.0 4.2.32 Allow haskell-src-exts-1.15 4.2.31 #61, support conduit-1.1 4.2.30 #57, support QuickCheck-2.7 4.2.29 #55, if reading as UTF8 fails, explicitly try Latin1 Add QuickCheck as a dependency Change createDatabase to also save the file Disable rank feature Remove running a hoogle query without converting the database Ignore packages without documentation to hoogle data 4.2.28 Upgrade to shake-0.11 #49, update "hoogle data" to be incremental 4.2.27 Rewrite how "hoogle data" works #45, if you are building all, also depend on default #47, switch to using Shake to build the recipes Add a dependency on Shake 4.2.26 Fix omission of the Test file 4.2.25 Fix timestamps in .tar.gz dist file 4.2.24 Allow WAI 2.0 Fix the Keyword generator 4.2.23 Improvements to Haddock conversion 4.2.22 Download Hoogle data from the old Hackage server 4.2.21 #25, make the tarball pass the tests #26, GHC 7.8 compatibility Ensure alias resolution is bottom-up and recursive 4.2.20 #619, do not depend on unix on Windows 4.2.19 Fix version bounds 4.2.18 Allow bytestring-0.9 4.2.17 Upgrade to haskell-src-exts-1.14 Visual redesign Require bytestring-0.10 or above, due to NFData instances Add NFData instance to Database 4.2.16 Remove lots of explicit upper bounds 4.2.15 Allow http-types-0.8 Allow case-insensitive-1.0 Support --local for GHC docs #568, rewrite Haddock links in --local 4.2.14 Switch license from GPL to BSD3 GHC 7.6 fixes ##4, Allow Cabal-1.16.* 4.2.13 Allow cmdargs-0.10.* 4.2.12 Allow conduit-0.5, wai-1.3 and warp-1.3 Upgrade to http-types-0.7.* In embedded mode, don't hijack the URL bar or title Upgrade to jQuery 1.7.2 #89, add a format=json output mode #476, update the URL as you type Improve iPhone support Update the copyright year in the footer Double the speed of hoogle server responses 4.2.11 Allow transformers-0.3 Allow conduit-0.4, wai-1.2 and warp-1.2 Allow haskell-src-exts-1.12 and 1.13 4.2.10 #533, be paranoid when parsing Cabal files 4.2.9 Upgrade to WAI-1.1 and Warp-1.1 #525, don't rely on a redirect to find files Allow Cabal-1.14 4.2.8 Allow cmdargs-0.9 Fix setting the global read flags and unsetting them properly Allow case-insensitive-0.4.* Make data --local have a good default on Linux Make server --local work on Windows #407, rewrite OpenSearch plugin to work regardless of the server 4.2.7 Allow cmdargs-0.8 4.2.6 Permit GHC 7.2 Allow case-insensitive-0.3.* Fix bug when searching for toString in the embed mode Make --redownload work on the tarballs 4.2.5 Fix hyperlinks to symbols (i.e. &&) in Haddock 4.2.4 #434, use either wget or curl to download the files Allow haskell-src-exts 1.11.* Upgrade to cmdargs==0.7.* 4.2.3 Generate database for ghc internals Give an error if the database is the wrong version Add -fno-cse, to make cmdargs work (was losing args annotations) 4.2.2 Upgrade to WAI==0.4.* and Warp==0.4.* Allow parsec 3, since various people have reported it works Default module URL's correctly when not on Hackage #417, use proper Haddock parsing for package descriptions Make sure https: links work through the web mode Rewrite the binary defer layer, cleaner and slightly faster Eliminate escaping problems when entering "'s in the search Some work on #375, add links to the library page Add --template to override the templates at runtime Add --dynamic flag to server mode, include update stamps Upgrade wai and warp, adds an exception handler #82, rewrite showing document snippets, better expand/collapse Support tags in Haddock output (as well as ) Make package matching case insensitive #372, add features to improve module name search Make module name searching case insensitive 4.2.1 Fix for pattern match failure when searching for "to" Fix for not sending text/html when serving local files Eliminate the --nostdin flag, now unnecessary Change to use WAI/Warp instead of HTTP and custom server Fix a bug, didn't ever show Waiting... on the real website Make embed work in IE8 4.2 Make the CGI interface send the right number of newlines Accept prefix and suffix web parameters Eliminate isBlankQuery, make Query a Monoid Make Query abstract, add queryPackages/querySetPackage Rename querySuggestions/queryCompletions by dropping the query Add mode=embed support Add some log analysis features Ignore some whitespace in the input file Work around a cabal bug, include jquery.cookie.js Add ?version=xxx to .css and .js, to make it auto refresh 4.1.5 #399, rehabilitate mode=suggest Stop mode=suggest failing entirely, now cleanly gives no answers Combine --web and --webmode Complete the command line flag help #327, ensure utf8 is found #187, ensure LT is found Use the Hoogle tarball direct from Hackage #54, rework packages, entries and keywords #87, make all database files lowercase Various javascript/ajax enhancements 4.1.4 Running data on Posix sets all files to global read/execute Relax haskell-src-exts to allow 1.10.1 Rework the web page display further 4.1.3 Read and write all database files in UTF8 #391, add tar -xzf when extracting from the tarball Change search results display, packages/modules on separate line Exclude haskellN* from the platform, they are in base Add --nostdin to server mode, to support running with nohup Loosen dependencies for tagsoup (typo'd it before) 4.1.2 Loosen dependencies for tagsoup and HTTP (but not parsec) Avoid self circular dependencies 4.1.1 #195, include all the necessary resources to run as a server When in server mode, be more robust to errors 4.1 #320, make sure system is found #146, preserve forall's in everywhere #186, switch to using haskell-src-exts to parse input files #249, make sure you find MonadWriter #235, make sure you find forall #309, make sure there are links for keywords #78, add --link flag #59, operators look nicer, and have blue brackets round them #352, can now parse ( # ) as a function name in the input #280, searching for "~ +keyword" should find keyword #116, fix links for types/classes #83, all searching for package-name #94, allow textbases to be used automatically #92, short flags are now handled by cmdargs, so work #51, test mode now does what test and testfile did #66, turn Hoogle into a library Add --server flag, to run as a server 4.0.7 Start of changelog hoogle-4.2.43/src/0000755000000000000000000000000012623347442012045 5ustar0000000000000000hoogle-4.2.43/src/Test.hs0000644000000000000000000000227612623347442013327 0ustar0000000000000000module 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 hoogle-4.2.43/src/Main.hs0000644000000000000000000000030412623347442013262 0ustar0000000000000000 module Main where import CmdLine.All import Console.All as Console import Web.All as Web main :: IO () main = do q <- cmdLine if isWebCmdLine q then Web.action q else Console.action q hoogle-4.2.43/src/Hoogle.hs0000644000000000000000000001532012623347442013617 0ustar0000000000000000 -- | The Hoogle API. To perform a search you call 'search' with a 'Database' (obtained by 'loadDatabase') and a -- 'Query' (obtained by 'parseQuery'). 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(..) ) 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 -- Hoogle.Query -- | Parse a query for a given language, returning either a parse error, or a query. parseQuery :: H.Language -> String -> Either H.ParseError Query parseQuery _ = H.parseQuery -- Hoogle.Search -- Invariant: locations will not be empty data Result = Result {locations :: [(URL, [(URL, String)])] -- your location, your parents ,self :: TagStr -- ^ Rendered view for the entry, including name/keywords/type as appropriate, colors matching 'renderQuery' ,docs :: TagStr -- ^ Documentation for the entry } deriving (Eq, Show) toResult :: H.Result -> (Score,Result) toResult r@(H.Result ent view score) = (score, Result parents self docs) where self = H.renderResult r parents = map (second $ map f) $ H.entryLocations ent f = (H.entryURL &&& H.entryName) . fromOnce docs = H.renderDocs $ H.entryDocs ent -- | 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 } hoogle-4.2.43/src/Web/0000755000000000000000000000000012623347442012562 5ustar0000000000000000hoogle-4.2.43/src/Web/Template.hs0000644000000000000000000001311112623347442014666 0ustar0000000000000000{-# 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 ++ "$" hoogle-4.2.43/src/Web/Server.hs0000644000000000000000000001340212623347442014364 0ustar0000000000000000{-# 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" hoogle-4.2.43/src/Web/Response.hs0000644000000000000000000002022512623347442014715 0ustar0000000000000000{-# 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} = "Parse error: " ++& errorMessage err ++ "" runEmbed dbs cq@Search{queryParsed = Right q} | null now = "No results found" | otherwise = unlines ["" ++ showTagHTML (transform f $ self $ snd x) ++ "" | 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 $ "" ++ showTagHTMLWith f x ++ "" 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 ["

" ++ qstr ++ "

"] ++ ["
  • Packages
    • " ++ also ++ "
" | not $ null pkgs] ++ ["

" ++ showTag sug ++ "

" | Just sug <- [suggestions dbs q]] ++ if null res then ["

No results found

"] else concat (pre ++ now) else concat now) ++ ["

Show more results

" | 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 "
  • " ++ x ++ "
    • " | (False,lx) `elem` queryPackages q = let q2 = showTagText $ renderQuery $ querySetPackage Nothing lx q in "
  • " ++ x ++ "
    • " | otherwise = let link b = searchLink $ showTagText $ renderQuery $ querySetPackage (Just b) lx q in "
  • " ++ "" ++ x ++ "
    • " 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{..} = ["" | more] ++ ["
    "] ++ ["
    " ++ href selfUrl (showTagHTMLWith url self) ++ "
    "] ++ ["
    " ++ intercalate ", " [unwords $ zipWith (f u) [1..] ps | (u,ps) <- locations] ++ "
    " | not $ null locations] ++ ["
    " ++ showTag docs ++ "
    " | let s = showTagText docs, s /= ""] ++ ["
    "] where selfUrl = head $ map fst locations ++ [""] f u cls (url,text) = "" ++ text ++ "" where url2 = if url == takeWhile (/= '#') u then u else url url (TagBold x) | null selfUrl = Just $ "" ++ showTagHTML (transform g x) ++ "" | otherwise = Just $ "" ++ showTagHTML (transform g x) ++ "" url _ = Nothing g (TagEmph x) = TagBold x g x = x href url x = if null url then x else "" ++ x ++ "" 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 hoogle-4.2.43/src/Web/Page.hs0000644000000000000000000001233112623347442013772 0ustar0000000000000000-- 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 = "" ++ "\n\n \n \n " ++ escapeHTML query ++ " " ++ escapeHTML queryHyphen ++ " Hoogle\n \n \n\t\t\n \n \n \n \n \n \n\n
    \n \n \"Hoogle\"\n\n \n \n
    \n
    \n" _footer version = "" ++ "
    \n
    \n
    © Neil Mitchell 2004-2013, version " ++ escapeHTML version ++ "
    \n \n\n" _welcome = "" ++ "

    Welcome to Hoogle

    \n\n

    \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

    \n

    \n Example searches:
    \n map\n
    \n (a -> b) -> [a] -> [b]\n
    \n Ord a => [a] -> [a]\n
    \n Data.Map.insert\n
    \n\t
    Enter your own search at the top of the page.\n

    \n

    \n The Hoogle manual 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

    \n

    \n I am very interested in any feedback you may have. Please\n email me, or add an entry to my\n bug tracker.\n

    \n" _parseError errFormat errMessage = "" ++ "

    " ++ errFormat ++ "

    \n

    \n\tParse error: " ++ escapeHTML errMessage ++ "\n

    \n\tFor information on what queries should look like, see the\n\tuser manual.\n

    \n" hoogle-4.2.43/src/Web/All.hs0000644000000000000000000000033012623347442013622 0ustar0000000000000000 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 hoogle-4.2.43/src/Test/0000755000000000000000000000000012623347442012764 5ustar0000000000000000hoogle-4.2.43/src/Test/Parse_TypeSig.hs0000644000000000000000000000742112623347442016042 0ustar0000000000000000 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"]) hoogle-4.2.43/src/Test/Parse_Query.hs0000644000000000000000000000275512623347442015570 0ustar0000000000000000 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"]} hoogle-4.2.43/src/Test/General.hs0000644000000000000000000000173212623347442014700 0ustar0000000000000000 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" hoogle-4.2.43/src/Test/Docs.hs0000644000000000000000000000043312623347442014210 0ustar0000000000000000 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 bar baz" =#= Tags [Str "foo ", TagEmph (Str "bar"), Str " baz"] hoogle-4.2.43/src/Test/BWT_FM.hs0000644000000000000000000000057312623347442014343 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Test/All.hs0000644000000000000000000000030412623347442014025 0ustar0000000000000000 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 hoogle-4.2.43/src/Recipe/0000755000000000000000000000000012623347442013254 5ustar0000000000000000hoogle-4.2.43/src/Recipe/Keyword.hs0000644000000000000000000000457512623347442015247 0ustar0000000000000000 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 (~== "") $ takeWhile (~/= "
    ") $ 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) = ["
    "] ++ map (drop n) ys ++ ["
    "] 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) = "" ++ innerText a ++ "" ++ f (drop 1 b) where (a,b) = break (~== "") xs f (x:xs) = h x ++ f xs f [] = [] h (TagText x) = unwords (lines x) h _ = "" docFormat (TagOpen "ul" _:xs) = ["
    • "] ++ intercalate ["
    • "] [docFormat (TagOpen "p" []:x) | x <- partitions (~== "
    • ") xs] ++ ["
    "] hoogle-4.2.43/src/Recipe/Haddock.hs0000644000000000000000000001343212623347442015150 0ustar0000000000000000{-# 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) = ["
    "] ++ map escapeHTML xs ++ ["
    "] convert (Blk xs) = ["
    "] ++ map parseInline xs ++ ["
    "] convert (Li xs) = ["
      "] ++ ["
    • " ++ x ++ "
      • " | x <- map parseInline xs] ++ ["
    "] 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 ++ "" 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] hoogle-4.2.43/src/Recipe/Hackage.hs0000644000000000000000000000277612623347442015147 0ustar0000000000000000 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") hoogle-4.2.43/src/Recipe/Command.hs0000644000000000000000000000507212623347442015172 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Recipe/Cabal.hs0000644000000000000000000000347512623347442014623 0ustar0000000000000000{-# 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] hoogle-4.2.43/src/Recipe/All.hs0000644000000000000000000002164612623347442014331 0ustar0000000000000000{-# 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) hoogle-4.2.43/src/Hoogle/0000755000000000000000000000000012623347442013262 5ustar0000000000000000hoogle-4.2.43/src/Hoogle/Type/0000755000000000000000000000000012623347442014203 5ustar0000000000000000hoogle-4.2.43/src/Hoogle/Type/TypeSig.hs0000644000000000000000000001246212623347442016130 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Hoogle/Type/TagStr.hs0000644000000000000000000001207612623347442015751 0ustar0000000000000000{-# 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) = "" ++ showTagHTML x ++ "" g (TagColor i x) = "" ++ showTagHTML x ++ "" nbsp (' ':' ':xs) = "  " ++ 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 /= ""] hoogle-4.2.43/src/Hoogle/Type/Result.hs0000644000000000000000000000063612623347442016022 0ustar0000000000000000 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 hoogle-4.2.43/src/Hoogle/Type/ParseError.hs0000644000000000000000000000205412623347442016624 0ustar0000000000000000{-# 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 "" hoogle-4.2.43/src/Hoogle/Type/Language.hs0000644000000000000000000000047112623347442016264 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Hoogle.Type.Language where import General.Base -- | The languages supported by Hoogle. data Language = Haskell -- ^ The Haskell language (), along with many GHC specific extensions. deriving (Enum,Read,Show,Eq,Ord,Bounded,Data,Typeable) hoogle-4.2.43/src/Hoogle/Type/Item.hs0000644000000000000000000001240012623347442015432 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Hoogle/Type/Docs.hs0000644000000000000000000000470112623347442015431 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Hoogle/Type/All.hs0000644000000000000000000000043612623347442015252 0ustar0000000000000000 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 hoogle-4.2.43/src/Hoogle/Store/0000755000000000000000000000000012623347442014356 5ustar0000000000000000hoogle-4.2.43/src/Hoogle/Store/WriteBuffer.hs0000644000000000000000000000617312623347442017145 0ustar0000000000000000{-# 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) hoogle-4.2.43/src/Hoogle/Store/Type.hs0000644000000000000000000001363312623347442015641 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Hoogle/Store/ReadBuffer.hs0000644000000000000000000000211112623347442016712 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Hoogle/Store/All.hs0000644000000000000000000001540012623347442015422 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Hoogle/Search/0000755000000000000000000000000012623347442014467 5ustar0000000000000000hoogle-4.2.43/src/Hoogle/Search/Results.hs0000644000000000000000000000627412623347442016475 0ustar0000000000000000 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 hoogle-4.2.43/src/Hoogle/Search/All.hs0000644000000000000000000000217312623347442015536 0ustar0000000000000000 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] hoogle-4.2.43/src/Hoogle/Score/0000755000000000000000000000000012623347442014335 5ustar0000000000000000hoogle-4.2.43/src/Hoogle/Score/Type.hs0000644000000000000000000000405412623347442015615 0ustar0000000000000000 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) hoogle-4.2.43/src/Hoogle/Score/Scoring.hs0000644000000000000000000000430112623347442016273 0ustar0000000000000000 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) hoogle-4.2.43/src/Hoogle/Score/All.hs0000644000000000000000000000031412623347442015377 0ustar0000000000000000 module Hoogle.Score.All( module Hoogle.Score.Scoring, Score, TypeCost(..), TextMatch(..), textScore, typeScore, scoreCosts, cost ) where import Hoogle.Score.Scoring import Hoogle.Score.Type hoogle-4.2.43/src/Hoogle/Query/0000755000000000000000000000000012623347442014367 5ustar0000000000000000hoogle-4.2.43/src/Hoogle/Query/Type.hs0000644000000000000000000000356712623347442015657 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Hoogle/Query/Suggest.hs0000644000000000000000000000375112623347442016352 0ustar0000000000000000 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 hoogle-4.2.43/src/Hoogle/Query/Render.hs0000644000000000000000000000263712623347442016152 0ustar0000000000000000 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 hoogle-4.2.43/src/Hoogle/Query/Parser.hs0000644000000000000000000001737412623347442016173 0ustar0000000000000000{-# 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) hoogle-4.2.43/src/Hoogle/Query/All.hs0000644000000000000000000000026212623347442015433 0ustar0000000000000000 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 hoogle-4.2.43/src/Hoogle/Language/0000755000000000000000000000000012623347442015005 5ustar0000000000000000hoogle-4.2.43/src/Hoogle/Language/Haskell.hs0000644000000000000000000002635712623347442016741 0ustar0000000000000000{-# 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] hoogle-4.2.43/src/Hoogle/DataBase2/0000755000000000000000000000000012623347442015010 5ustar0000000000000000hoogle-4.2.43/src/Hoogle/DataBase2/Type.hs0000644000000000000000000000056612623347442016274 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Hoogle/DataBase2/Str.hs0000644000000000000000000000511012623347442016111 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Hoogle/DataBase/0000755000000000000000000000000012623347442014726 5ustar0000000000000000hoogle-4.2.43/src/Hoogle/DataBase/Type.hs0000644000000000000000000000315212623347442016204 0ustar0000000000000000{-# 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] hoogle-4.2.43/src/Hoogle/DataBase/Suggest.hs0000644000000000000000000001256712623347442016716 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Hoogle/DataBase/SubstrSearch.hs0000644000000000000000000001610312623347442017673 0ustar0000000000000000{-# 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 Nothinghoogle-4.2.43/src/Hoogle/DataBase/Serialise.hs0000644000000000000000000000340612623347442017205 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Hoogle/DataBase/Items.hs0000644000000000000000000000425612623347442016352 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Hoogle/DataBase/Instances.hs0000644000000000000000000000321012623347442017205 0ustar0000000000000000 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 hoogle-4.2.43/src/Hoogle/DataBase/All.hs0000644000000000000000000000601612623347442015775 0ustar0000000000000000module 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) hoogle-4.2.43/src/Hoogle/DataBase/Aliases.hs0000644000000000000000000000577312623347442016657 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Hoogle/DataBase/TypeSearch/0000755000000000000000000000000012623347442016775 5ustar0000000000000000hoogle-4.2.43/src/Hoogle/DataBase/TypeSearch/TypeScore.hs0000644000000000000000000000443112623347442021250 0ustar0000000000000000 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 hoogle-4.2.43/src/Hoogle/DataBase/TypeSearch/Result.hs0000644000000000000000000000623512623347442020615 0ustar0000000000000000 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) hoogle-4.2.43/src/Hoogle/DataBase/TypeSearch/Graphs.hs0000644000000000000000000001052412623347442020557 0ustar0000000000000000 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) } hoogle-4.2.43/src/Hoogle/DataBase/TypeSearch/Graph.hs0000644000000000000000000000544512623347442020402 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Hoogle/DataBase/TypeSearch/EntryInfo.hs0000644000000000000000000000202112623347442021241 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Hoogle/DataBase/TypeSearch/Binding.hs0000644000000000000000000000735612623347442020716 0ustar0000000000000000{-| 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] hoogle-4.2.43/src/Hoogle/DataBase/TypeSearch/All.hs0000644000000000000000000000236512623347442020047 0ustar0000000000000000 -- 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] hoogle-4.2.43/src/General/0000755000000000000000000000000012623347442013422 5ustar0000000000000000hoogle-4.2.43/src/General/Web.hs0000644000000000000000000001277712623347442014511 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE PatternGuards #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} -- becomes confusing with all the CPP {- | General web utility functions. -} module General.Web( responseOK, responseNotFound, responseFlatten, responseEvaluate, responseRewrite, URL, filePathToURL, combineURL, escapeURL, (++%), unescapeURL, escapeHTML, (++&), htmlTag, Args, cgiArgs, cgiResponse, parseHttpQueryArgs ) where #ifndef MIN_VERSION_wai #define MIN_VERSION_wai(a,b,c) 1 #endif import General.System import General.Base import System.FilePath 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 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 '<' = "<" f '>' = ">" f '&' = "&" f '\"' = """ 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 ++ "" --------------------------------------------------------------------- -- 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 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] --------------------------------------------------------------------- -- HTTP STUFF parseHttpQueryArgs :: String -> Args parseHttpQueryArgs xs = mapMaybe (f . splitPair "=") $ splitList "&" xs where f Nothing = Nothing f (Just (a,b)) = Just (unescapeURL a, unescapeURL b) 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 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 hoogle-4.2.43/src/General/Util.hs0000644000000000000000000000623512623347442014701 0ustar0000000000000000 module General.Util where import General.Base import qualified Data.Set as Set 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 -- | Only append strings if neither one is empty (++?) :: String -> String -> String a ++? b = if null a || null b then [] else a ++ b groupOn f = groupBy ((==) `on` f) nubOn f = nubBy ((==) `on` f) sortFst mr = sortOn fst mr groupFst mr = groupOn fst mr groupFsts :: Eq k => [(k,v)] -> [(k,[v])] groupFsts = map (fst . head &&& map snd) . groupFst sortGroupFsts mr = groupFsts . sortFst $ mr sortGroupFst mr = groupFst . sortFst $ mr fold :: a -> (a -> a -> a) -> [a] -> a fold x f [] = x fold x f xs = fold1 f xs fold1 :: (a -> a -> a) -> [a] -> a fold1 f [x] = x fold1 f xs = f (fold1 f a) (fold1 f b) where (a,b) = halves xs halves :: [a] -> ([a],[a]) halves [] = ([], []) halves (x:xs) = (x:b,a) where (a,b) = halves xs 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 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 merges :: Ord a => [[a]] -> [a] merges = fold [] merge mergesBy :: (a -> a -> Ordering) -> [[a]] -> [a] mergesBy f = fold [] (mergeBy f) 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 rep from to x = if x == from then to else x reps from to = map (rep from to) -- | Like splitAt, but also return the number of items that were split. -- For performance. splitAtLength :: Int -> [a] -> (Int,[a],[a]) splitAtLength n xs = f n xs where f i xs | i == 0 = (n,[],xs) f i [] = (n-i,[],[]) f i (x:xs) = (a,x:b,c) where (a,b,c) = f (i-1) xs rbreak f xs = case break f $ reverse xs of (_, []) -> (xs, []) (as, b:bs) -> (reverse bs, b:reverse as) compareCaseless :: String -> String -> Ordering compareCaseless x = compare (map toLower x) . map toLower -- 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 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 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 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) hoogle-4.2.43/src/General/TypeMap.hs0000644000000000000000000000171112623347442015335 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/General/System.hs0000644000000000000000000000373412623347442015251 0ustar0000000000000000{-# 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) hoogle-4.2.43/src/General/Heap.hs0000644000000000000000000000375112623347442014641 0ustar0000000000000000 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) hoogle-4.2.43/src/General/FMIndex.hs0000644000000000000000000000402212623347442015246 0ustar0000000000000000 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 hoogle-4.2.43/src/General/BurrowsWheeler.hs0000644000000000000000000000435112623347442016740 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, PatternGuards #-} -- | Burrows-Wheeler Transform, based on . 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 hoogle-4.2.43/src/General/Base.hs0000644000000000000000000000700112623347442014626 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Console/0000755000000000000000000000000012623347442013447 5ustar0000000000000000hoogle-4.2.43/src/Console/Test.hs0000644000000000000000000001020312623347442014716 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Console/Search.hs0000644000000000000000000000514112623347442015211 0ustar0000000000000000{-# 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' hoogle-4.2.43/src/Console/Rank.hs0000644000000000000000000000225412623347442014701 0ustar0000000000000000{-# 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 hoogle-4.2.43/src/Console/Log.hs0000644000000000000000000001452612623347442014534 0ustar0000000000000000{-# 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) hoogle-4.2.43/src/Console/All.hs0000644000000000000000000000562412623347442014522 0ustar0000000000000000 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 hoogle-4.2.43/src/CmdLine/0000755000000000000000000000000012623347442013360 5ustar0000000000000000hoogle-4.2.43/src/CmdLine/Type.hs0000644000000000000000000001260612623347442014642 0ustar0000000000000000{-# 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" hoogle-4.2.43/src/CmdLine/Load.hs0000644000000000000000000000174512623347442014602 0ustar0000000000000000 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"] hoogle-4.2.43/src/CmdLine/All.hs0000644000000000000000000000723212623347442014430 0ustar0000000000000000{-| 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 hoogle-4.2.43/docs/0000755000000000000000000000000012623347442012206 5ustar0000000000000000hoogle-4.2.43/docs/LICENSE0000644000000000000000000000276412623347442013224 0ustar0000000000000000Copyright 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-4.2.43/datadir/0000755000000000000000000000000012623347442012666 5ustar0000000000000000hoogle-4.2.43/datadir/tests.txt0000644000000000000000000000400312623347442014566 0ustar0000000000000000-- 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 hoogle-4.2.43/datadir/testdata.txt0000644000000000000000000000212412623347442015237 0ustar0000000000000000-- 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 foo_bar 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 hoogle-4.2.43/datadir/rank.txt0000644000000000000000000000160712623347442014366 0ustar0000000000000000-- 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 hoogle-4.2.43/datadir/examples.txt0000644000000000000000000000267012623347442015252 0ustar0000000000000000-- 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 hoogle-4.2.43/datadir/resources/0000755000000000000000000000000012623347442014700 5ustar0000000000000000hoogle-4.2.43/datadir/resources/template_example.html0000644000000000000000000000037012623347442021114 0ustar0000000000000000 #homepage example.com #export welcome

    Welcome to Hoogle

    This copy of Hoogle overrides a few example settings, to allow you to better integrate it in any local installations.

    hoogle-4.2.43/datadir/resources/template.html0000644000000000000000000000726112623347442017407 0ustar0000000000000000 #export header css js query $&query$ $&queryHyphen$ Hoogle
    #homepage haskell.org #export footer version
    #search $&query$ #export welcome

    Welcome to Hoogle

    Hoogle is a Haskell API search engine, which allows you to search many standard Haskell libraries by either function name, or by approximate type signature.

    Example searches:
    $query=map$ $#search$
    $query=(a -> b) -> [a] -> [b]$ $#search$
    $query=Ord a => [a] -> [a]$ $#search$
    $query=Data.Map.insert$ $#search$

    Enter your own search at the top of the page.

    The Hoogle manual 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.

    I am very interested in any feedback you may have. Please email me, or add an entry to my bug tracker.

    #export parseError

    $!errFormat$

    Parse error: $&errMessage$

    For information on what queries should look like, see the user manual.

    hoogle-4.2.43/datadir/resources/spinner.gif0000644000000000000000000000376512623347442017060 0ustar0000000000000000GIF89a鵵<<<򭭭۪׻&&&عˮRRRꅅJJJ Ѥ)))]]]̷YYYfffʦุzzzNNNjjjֺnnnޖaaatttTTTFFFWWW222www|||666qqqAAAlllxxx---###Ҭ! NETSCAPE2.0!,Ȁ-h _W -%Mo>j`=^:Q!6 53p6ZO/Q,);Q  G@l^ba"-$ R:σ1?T"!J `Ą%* ċl4HDa+Q4\"  RaVg @!, otp8_sZ7L2>ngwhP7'tbcAr.: *2rb"K[\,A?B= M"- aɊH!1?!,d d=befN>]Ic.lF61 Zb3gA#Mc_XdE7k_$17|yC,FwWmZ'/zR[ #VQ!,b -%#!2;/ZY!Nqjc6#Pb,O e5.=P_veVf*gJ&moo6dKq$>|`͇)" !, m#=!2;/2Y!6  O!G#H;2^^H+c3d;JqBfEfZ!_m*.G>Sg<(hSkRPp!, rB1 OD,U  GM& !R ,D(HmzP 2-FbnG}5Z`ch+3!DIe/;cZ !, dV,P33fA}EmE"-,$Cd{u?F|e=b 2(],G3K!j%y[_t e?QF+H5"0(). !, rO:!2;>W."X2Y!Ml|sN1d^X_pxk7hG% HmFnS. CCJ]PL6^j?#V5' +)!,a :8oC|u(U! 3s hP'X*h^;edj%dXXg(D)nePI~q='/$ ;hoogle-4.2.43/datadir/resources/search.xml0000644000000000000000000000206312623347442016670 0ustar0000000000000000 Hoogle Hoogle - Haskell API Search 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. haskell http://haskell.org/hoogle/res/favicon.png http://haskell.org/hoogle/res/favicon64.png Neil Mitchell false en-us UTF-8 UTF-8 hoogle-4.2.43/datadir/resources/more_small.png0000644000000000000000000000031212623347442017534 0ustar0000000000000000PNG  IHDR [AgAMA atEXtSoftwarewww.inkscape.org<PLTENN~׃8IDATc(/VR2/g()/w g(L/`/g0)/`/wfPQE @ P%P P[uhVIENDB`hoogle-4.2.43/datadir/resources/more_gray.png0000644000000000000000000000031312623347442017367 0ustar0000000000000000PNG  IHDR ҎtEXtCreation Time!|tIME-T] pHYs  ~PLTE޵t(IDATcH4cLKKbKcHK pI+ ? ԃ2IENDB`hoogle-4.2.43/datadir/resources/more_blue.png0000644000000000000000000000043312623347442017357 0ustar0000000000000000PNG  IHDR atEXtCreation Time -@GtIME -4 pHYs  ~").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?"":"")+""),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;g0){if(c!=="border")for(;e=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)[^>]*$|#([\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(;j0)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(;g0&&a[0]&&a[j-1]||j===0||e.isArray(a));if(k)for(;i1?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
    a",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>",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="
    "+""+"
    ",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="
    t
    ",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="
    ",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;e1,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.length1)},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-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=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=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=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;le&&j.push({elem:this,matches:d.slice(e)});for(k=0;k0?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;h0){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+~,(\[\\]+)+|[>+~])(\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;b0},m.find=function(a,b,c){var d,e,f,g,h,i;if(!a)return[];for(e=0,f=o.order.length;e":function(a,b){var c,d=typeof b=="string",e=0,f=a.length;if(d&&!l.test(b)){b=b.toLowerCase();for(;e=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 bc[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=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.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.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="

    ";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="
    ";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;h0)for(h=g;h=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-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:]+)/,$=/]","i"),bd=/checked\s*(?:[^=]|=\s*.checked.)/i,be=/\/(java|ecma)script/i,bf=/^\s*",""],legend:[1,"
    ","
    "],thead:[1,"","
    "],tr:[2,"","
    "],td:[3,"","
    "],col:[2,"","
    "],area:[1,"",""],_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
    ","
    "]),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>");try{for(;d1&&l0?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>");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]===""&&!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;i1)},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>/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("
    ").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=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-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);hoogle-4.2.43/datadir/resources/jquery-cookie.js0000644000000000000000000001022612623347442020025 0ustar0000000000000000/** * 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; } };hoogle-4.2.43/datadir/resources/hoogle.png0000644000000000000000000000600712623347442016666 0ustar0000000000000000PNG  IHDR:P_gAMA a IDATx P^WC]j]>.c\RѺתVUkժuq YJBBV,B d!;$ l$$AB<;o#|{ Cw޻s9d̀n#K 6ni 6niZ{hׯ]q]c1c3qnX0uSizfkv|hNߟYo5-3as>8Ϲ76g 301'3X~`[\ӹWb]<~sHّ) _^: ƿxV_y܋ƵWG~f0R{:{\?r>t1j ǝ=`DYe+2rcO/FGC]ueyw|!';B %TUK|G57QIH= 7eje,:wwTV1jg* et׮\Dg|=C ;خcbTWF2 lEarTM1=>pn jY.LurI1Q:[:O;ٺy'ahu$ML{Lݙms̥?{@[g T}}iHPg?-LuSUĨfd60X {a..ػc$/s*W^3IgkoD1ԨA& @^x5=ΰdڶm9OxgH/9R>o,`h/D-L$s?2WpO@ԎnsݣvZ ܂O/bb\72K;FݽJUjZd/w\Y&DGlV\M0ﭐov1*ǹ[=hsVrë66U ꥫ~Jjv:ljU2 !o ݊'W8QQz55l4\&uK,E{=~R\B ϕ VVOEGx7N3Mz+箈e\QwM!`W-|Eβ)qf^D=R_TG QQO/phj5|4m\|87 ?d .0d JQ"?@DOS1(oY$JBp g,:}j Ln5 Fdzԏ~i:߬tnnZ]"; Z b+@[;g Ct= 2'FEV }wO㐑A"o]0+',X>j.}G.(GR%9-xS& s` NCpPݽ@޲居*.'ZK1[k`»@idRLIPUb! 2dN2yl?wў*$e%r F8a!D{H1(Ƶ;i飯Uk[.S򁵿~U/'a+" Ϭ'HQ@Pmiz5Cc3XCՇ̩LnR퐛#}KPw̴Ɛ@ s39nzԲ!6c:V_Ӄ-{v/D^ABK Hy;Q8 5vhF6m [ }{OrvȀ,֎e8.M{Ȱw P*+tCjtj{ BHËr^%SR! gΙf51*&Aݱ{b8^ 27c`lwpHA8voX˻IY<1I@$Q°1KPh^@\(''x0MW_X:Ȋy0a>N!ЛH9#@[gc688W$HfjתlAhPӴp/T UgoHX8yr lMf<[NV>sPo li8(j|[Nm&Q* osSٶo[MzuhGJS Մ65K ߴo3V?>0 1rwbX8mDրr`2)Bع⡂!wyCKvli_ <8];&uMX7m`ݴua3bIENDB`hoogle-4.2.43/datadir/resources/hoogle.js0000644000000000000000000003156112623347442016521 0ustar0000000000000000var 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("

    Error: status " + status + "

    " + text + "

    ")}, 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 = $("