").appendTo($contents.find("body"));
+ });
+ $iframe.insertBefore($hoogle);
+ var finishOnBlur = true; // Should a blur hide the box
+
+ function show(x){
+ if (x == undefined)
+ $iframe.css("display","none");
+ else {
+ $body.html(x).find("a").attr("target","_parent")
+ .mousedown(function(){finishOnBlur = false;})
+ .mouseup(function(){finishOnBlur = true;})
+ .mouseenter(function(){
+ $body.find(".sel").removeClass("sel");
+ $(this).addClass("sel");
+ });
+
+ var pos = $hoogle.position();
+ // need to display before using $body.outerHeight() on Firefox
+ $iframe.css("display","").css(
+ {top:px(pos.top + $hoogle.outerHeight() + unpx($hoogle.css("margin-top")))
+ ,left:px(pos.left + unpx($hoogle.css("margin-left")))
+ ,width:px($hoogle.outerWidth() - 2 /* iframe border */)
+ ,height:$body.outerHeight()
+ });
+ }
+ }
+
+ $hoogle.blur(function(){if (finishOnBlur) show();});
+
+ $hoogle.keydown(function(event){
+ switch(event.which)
+ {
+ case Key.Return:
+ var sel = $body.find(".sel:first");
+ if (sel.size() == 0) return;
+ event.preventDefault();
+ document.location.href = sel.attr("href");
+ break;
+
+ case Key.Escape:
+ $body.find(".sel").removeClass("sel");
+ show();
+ break;
+
+ case Key.Down: case Key.Up:
+ var i = event.which == Key.Down ? 1 : -1;
+ var all = $body.find("a");
+ var sel = all.filter(".sel");
+ var now = all.index(sel);
+ if (now == -1)
+ all.filter(i == 1 ? ":first" : ":last").addClass("sel");
+ else {
+ sel.removeClass("sel");
+ // IE treats :eq(-1) as :eq(0), so filter specifically
+ if (now+i >= 0) all.filter(":eq(" + (now+i) + ")").addClass("sel");
+ }
+ event.preventDefault();
+ break;
+ }
+ });
+
+ return {
+ showWaiting: function(){show("
Still working...");},
+ showError: function(status,text){show("
Error: status " + status + "");},
+ showResult : function(text){show(text);},
+ hide: function(){show();}
+ }
+}
+
+
/////////////////////////////////////////////////////////////////////
-// INSTANT
+// INSTANT BUTTON
$(function(){
- setInstant($.getQueryString('ajax') == "1" || $.cookie("instant") == "1");
- $("#instant").css("display","");
+ if (embed)
+ instant = true;
+ else
+ {
+ setInstant($.getQueryString('ajax') == "1" || $.cookie("instant") == "1");
+ $("#instant").css("display","");
+ }
});
function setInstant(x)
@@ -61,7 +185,7 @@
if (instant)
{
$.cookie("instant","1",{expires:365});
- searchBoxChange();
+ $hoogle.keyup();
}
else
$.cookie("instant",null);
@@ -72,6 +196,7 @@
// SEARCH PLUGIN
$(function(){
+ if (embed) return;
if (window.external && ("AddSearchProvider" in window.external))
$("#plugin").css("display","");
});
@@ -96,31 +221,9 @@
/////////////////////////////////////////////////////////////////////
-// CACHE
-
-function cache(maxElems)
-{
- // FIXME: Currently does not evict things
- var contents = {}; // what we have in the cache
-
- return {
- add: function(key,val)
- {
- contents[key] = val;
- },
-
- ask: function(key)
- {
- return contents[key];
- }
- };
-}
-
-
-
-/////////////////////////////////////////////////////////////////////
-// EXTERNAL jQUERY BITS
+// LIBRARY BITS
+// Access the browser query string
// From http://stackoverflow.com/questions/901115/get-querystring-values-with-jquery/3867610#3867610
;(function ($) {
$.extend({
@@ -146,3 +249,43 @@
}
});
})(jQuery);
+
+
+var Key = {
+ Up: 38,
+ Down: 40,
+ Return: 13,
+ Escape: 27
+};
+
+
+function unpx(x){var r = 1 * x.replace("px",""); return isNaN(r) ? 0 : r;}
+function px(x){return x + "px";}
+
+
+function cache(maxElems)
+{
+ // FIXME: Currently does not evict things
+ var contents = {}; // what we have in the cache
+
+ return {
+ add: function(key,val)
+ {
+ contents[key] = val;
+ },
+
+ ask: function(key)
+ {
+ return contents[key];
+ }
+ };
+}
+
+
+function watchdog(time, fun)
+{
+ var id = undefined;
+ function stop(){if (id == undefined) return; window.clearTimeout(id); id = undefined;}
+ function start(){stop(); id = window.setTimeout(function(){id = undefined; fun();}, time);}
+ return {start:start, stop:stop}
+}
diff --git a/datadir/resources/jquery.cookie.js b/datadir/resources/jquery.cookie.js
new file mode 100644
--- /dev/null
+++ b/datadir/resources/jquery.cookie.js
@@ -0,0 +1,96 @@
+/**
+ * Cookie plugin
+ *
+ * Copyright (c) 2006 Klaus Hartl (stilbuero.de)
+ * Dual licensed under the MIT and GPL licenses:
+ * http://www.opensource.org/licenses/mit-license.php
+ * http://www.gnu.org/licenses/gpl.html
+ *
+ */
+
+/**
+ * Create a cookie with the given name and value and other optional parameters.
+ *
+ * @example $.cookie('the_cookie', 'the_value');
+ * @desc Set the value of a cookie.
+ * @example $.cookie('the_cookie', 'the_value', { expires: 7, path: '/', domain: 'jquery.com', secure: true });
+ * @desc Create a cookie with all available options.
+ * @example $.cookie('the_cookie', 'the_value');
+ * @desc Create a session cookie.
+ * @example $.cookie('the_cookie', null);
+ * @desc Delete a cookie by passing null as value. Keep in mind that you have to use the same path and domain
+ * used when the cookie was set.
+ *
+ * @param String name The name of the cookie.
+ * @param String value The value of the cookie.
+ * @param Object options An object literal containing key/value pairs to provide optional cookie attributes.
+ * @option Number|Date expires Either an integer specifying the expiration date from now on in days or a Date object.
+ * If a negative value is specified (e.g. a date in the past), the cookie will be deleted.
+ * If set to null or omitted, the cookie will be a session cookie and will not be retained
+ * when the the browser exits.
+ * @option String path The value of the path atribute of the cookie (default: path of page that created the cookie).
+ * @option String domain The value of the domain attribute of the cookie (default: domain of page that created the cookie).
+ * @option Boolean secure If true, the secure attribute of the cookie will be set and the cookie transmission will
+ * require a secure protocol (like HTTPS).
+ * @type undefined
+ *
+ * @name $.cookie
+ * @cat Plugins/Cookie
+ * @author Klaus Hartl/klaus.hartl@stilbuero.de
+ */
+
+/**
+ * Get the value of a cookie with the given name.
+ *
+ * @example $.cookie('the_cookie');
+ * @desc Get the value of a cookie.
+ *
+ * @param String name The name of the cookie.
+ * @return The value of the cookie.
+ * @type String
+ *
+ * @name $.cookie
+ * @cat Plugins/Cookie
+ * @author Klaus Hartl/klaus.hartl@stilbuero.de
+ */
+jQuery.cookie = function(name, value, options) {
+ if (typeof value != 'undefined') { // name and value given, set cookie
+ options = options || {};
+ if (value === null) {
+ value = '';
+ options.expires = -1;
+ }
+ var expires = '';
+ if (options.expires && (typeof options.expires == 'number' || options.expires.toUTCString)) {
+ var date;
+ if (typeof options.expires == 'number') {
+ date = new Date();
+ date.setTime(date.getTime() + (options.expires * 24 * 60 * 60 * 1000));
+ } else {
+ date = options.expires;
+ }
+ expires = '; expires=' + date.toUTCString(); // use expires attribute, max-age is not supported by IE
+ }
+ // CAUTION: Needed to parenthesize options.path and options.domain
+ // in the following expressions, otherwise they evaluate to undefined
+ // in the packed version for some reason...
+ var path = options.path ? '; path=' + (options.path) : '';
+ var domain = options.domain ? '; domain=' + (options.domain) : '';
+ var secure = options.secure ? '; secure' : '';
+ document.cookie = [name, '=', encodeURIComponent(value), expires, path, domain, secure].join('');
+ } else { // only name given, get cookie
+ var cookieValue = null;
+ if (document.cookie && document.cookie != '') {
+ var cookies = document.cookie.split(';');
+ for (var i = 0; i < cookies.length; i++) {
+ var cookie = jQuery.trim(cookies[i]);
+ // Does this cookie string begin with the name we want?
+ if (cookie.substring(0, name.length + 1) == (name + '=')) {
+ cookieValue = decodeURIComponent(cookie.substring(name.length + 1));
+ break;
+ }
+ }
+ }
+ return cookieValue;
+ }
+};
diff --git a/hoogle.cabal b/hoogle.cabal
--- a/hoogle.cabal
+++ b/hoogle.cabal
@@ -1,7 +1,7 @@
cabal-version: >= 1.6
build-type: Simple
name: hoogle
-version: 4.1.5
+version: 4.2
license: GPL
license-file: docs/LICENSE
category: Development
@@ -26,6 +26,7 @@
resources/*.png
-- surely a Cabal bug that this isn't picked up by *.js
resources/jquery-1.4.2.js
+ resources/jquery.cookie.js
library
hs-source-dirs: src
@@ -84,6 +85,7 @@
Hoogle.DataBase.TypeSearch.All
Hoogle.Type.Documentation
Hoogle.Type.Item
+ Hoogle.Type.Language
Hoogle.Type.TagStr
Hoogle.Type.TypeSig
Hoogle.Type.ParseError
@@ -101,7 +103,7 @@
hs-source-dirs: src
build-depends:
- time,
+ time, old-locale,
cmdargs == 0.6.*,
tagsoup >= 0.11 && < 0.13,
network >= 2.2 && < 2.4,
@@ -113,6 +115,7 @@
CmdLine.Load
CmdLine.Type
Console.All
+ Console.Log
Console.Rank
Console.Search
Console.Test
diff --git a/src/CmdLine/All.hs b/src/CmdLine/All.hs
--- a/src/CmdLine/All.hs
+++ b/src/CmdLine/All.hs
@@ -95,6 +95,6 @@
cmdLineWeb args = cmdLineExpand $ blankSearch
{web=Just $ fromMaybe "web" $ ask ["mode"]
,start=askInt ["start"], count=askInt ["count"]
- ,queryChunks = maybeToList $ ask ["q","hoogle"]}
+ ,queryChunks = mapMaybe ask [["prefix"],["q","hoogle"],["suffix"]]}
where ask x = listToMaybe [b | (a,b) <- args, a `elem` x]
askInt x = readMay =<< ask x
diff --git a/src/CmdLine/Type.hs b/src/CmdLine/Type.hs
--- a/src/CmdLine/Type.hs
+++ b/src/CmdLine/Type.hs
@@ -35,6 +35,7 @@
| Server {port :: Int, local_ :: Bool, databases :: [FilePath], resources :: FilePath, nostdin :: Bool}
| Combine {srcfiles :: [FilePath], outfile :: String}
| Convert {srcfile :: String, outfile :: String}
+ | Log {logfiles :: [FilePath]}
| Test {testFiles :: [String], example :: Bool}
| Dump {database :: String, section :: [String]}
| Rank {srcfile :: FilePath}
@@ -43,7 +44,7 @@
emptyParseError = ParseError 0 0 "" $ Str ""
blankSearch = Search False False False [] Nothing Nothing Nothing 1 [] (Left emptyParseError) ""
-cmdLineMode = cmdArgsMode $ modes [search_ &= auto,dataa,server,combine,convert,test,dump,rank]
+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-2011\nhttp://haskell.org/hoogle")
@@ -92,7 +93,7 @@
,outfile = def &= argPos 1 &= typ "DATABASE" &= opt ""
} &= help "Convert an input file to a database"
-dataa = Data
+data_ = Data
{datadir = def &= typDir &= help "Database directory"
,redownload = def &= help "Redownload all files from the web"
,threads = def &= typ "INT" &= name "j" &= help "Number of threads to use" &= ignore -- ignore until it works
@@ -105,3 +106,7 @@
," data default -- equialent to no arguments"
," data all"
]
+
+log_ = Log
+ {logfiles = def &= args &= typ "LOGFILE"
+ } &= help "Analyse log files"
diff --git a/src/Console/All.hs b/src/Console/All.hs
--- a/src/Console/All.hs
+++ b/src/Console/All.hs
@@ -3,6 +3,7 @@
import CmdLine.All
import Recipe.All
+import Console.Log
import Console.Search
import Console.Test
import Console.Rank
@@ -33,6 +34,8 @@
action x@Data{} = recipes x
+action (Log files) = logFiles files
+
action (Convert from to) = do
to <- return $ if null to then replaceExtension from "hoo" else to
when (any isUpper $ takeBaseName to) $ putStrLn $ "Warning: Hoogle databases should be all lower case, " ++ takeBaseName to
@@ -53,7 +56,7 @@
putStrLn $ "File: " ++ file
putStr $ showDatabase d $ if null sections then Nothing else Just sections
-action q@Search{} | isBlankQuery $ fromRight $ queryParsed q =
+action q@Search{} | fromRight (queryParsed q) == mempty =
exitMessage ["No query entered"
,"Try --help for command line options"]
diff --git a/src/Console/Log.hs b/src/Console/Log.hs
new file mode 100644
--- /dev/null
+++ b/src/Console/Log.hs
@@ -0,0 +1,205 @@
+{-# 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 BS
+import qualified Data.Map as Map
+
+type BString = BS.ByteString
+
+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 BString Int)
+ }
+
+instance Show Stats where
+ show Stats{..} = unlines
+ ["Hits: " ++ show hits
+ ,"Searches: " ++ show searches
+ ,"Unique: " ++ show (Map.size common)
+ ,"Top: " ++ fromList "" (map (BS.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 BS.null search then 0 else 1) + searches
+ ,common = if BS.null search then common else Map.insertWith' (+) search 1 common
+ }
+
+
+---------------------------------------------------------------------
+-- GROUP ENTRIES
+
+groupEntries :: [Entry] -> [Entry]
+groupEntries = id
+
+
+---------------------------------------------------------------------
+-- READ ENTRIES
+
+data Entry = Entry
+ {search :: BString -- the search performed, "" for blank
+ ,extra :: [(BString,BString)] -- 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 Show
+
+entry = Entry BS.empty [] Nothing Nothing Nothing Nothing Nothing
+
+
+readEntries :: FilePath -> IO [Entry]
+readEntries x = do
+ src <- BS.readFile x
+ return $ mapMaybe readEntry $ BS.lines src
+
+
+qstr = map BS.pack ["","q","hoogle"]
+
+readEntry :: BString -> Maybe Entry
+
+-- log format v1
+readEntry x
+ | Just ('[',x) <- BS.uncons x
+ = do y <- readList x
+ let (a,b) = partition (flip elem qstr . fst) y
+ return entry{search=fromList BS.empty $ map snd a, extra = b}
+ where
+ readList x = do
+ ('(',x) <- BS.uncons x
+ (a,x) <- readShowString x
+ (',',x) <- BS.uncons x
+ (b,x) <- readShowString x
+ (')',x) <- BS.uncons x
+ case BS.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
+ | BS.length x > 10 && BS.index x 10 == ' '
+ = do (d,x) <- readDate x
+ (' ',x) <- BS.uncons x
+ (s,x) <- readShowString x
+ args <- readArgs $ BS.dropWhile isSpace x
+ return entry{search = s, date = Just d,
+ extra = filter (flip notElem qstr . fst) args}
+ where
+ readArgs x
+ | Just ('?',x) <- BS.uncons x = do
+ (a,x) <- return $ BS.break (== '=') x
+ ('=',x) <- BS.uncons x
+ (b,x) <- readQuoteString x
+ x <- return $ BS.dropWhile isSpace x
+ ys <- readArgs x
+ return $ (a,b) : ys
+ | otherwise = Just []
+
+
+-- log format v3
+readEntry x
+ | BS.length x > 10 && BS.index x 10 == 'T'
+ = do ((d,t),x) <- readDateTime x
+ (' ',x) <- BS.uncons x
+ (u,x) <- return $ first BS.unpack $ BS.break (== ' ') x
+ args <- readArgs $ BS.dropWhile isSpace x
+ let (a,b) = partition (flip elem qstr . fst) args
+ return entry{date = Just d, time = Just t, extra = b,
+ search=fromList BS.empty $ map snd a,
+ unique = if u == "0" then Nothing else Just u}
+ where
+ readArgs x
+ | BS.null x = Just []
+ | otherwise = do
+ (a,x) <- readShortString x
+ ('=',x) <- BS.uncons x
+ (b,x) <- readShortString x
+ ys <- readArgs $ BS.dropWhile isSpace x
+ return $ (a,b):ys
+
+readEntry _ = Nothing
+
+
+---------------------------------------------------------------------
+-- READ UTILITIES
+
+readDate :: BString -> Maybe ((Int,Int,Int), BString)
+readDate x = do
+ (d1,x) <- BS.readInt x
+ ('-',x) <- BS.uncons x
+ (d2,x) <- BS.readInt x
+ ('-',x) <- BS.uncons x
+ (d3,x) <- BS.readInt x
+ return ((d1,d2,d2),x)
+
+readDateTime :: BString -> Maybe (((Int,Int,Int),(Int,Int,Int)), BString)
+readDateTime x = do
+ (d,x) <- readDate x
+ ('T',x) <- BS.uncons x
+ (t1,x) <- BS.readInt x
+ (':',x) <- BS.uncons x
+ (t2,x) <- BS.readInt x
+ (':',x) <- BS.uncons x
+ (t3,x) <- BS.readInt x
+ return ((d,(t1,t2,t3)),x)
+
+
+-- | String, as produced by show
+readShowString :: BString -> Maybe (BString, BString)
+readShowString o@x = do
+ ('\"',x) <- BS.uncons x
+ (a,x) <- return $ BS.break (== '\"') x
+ if '\\' `BS.elem` a then do
+ [(a,x)] <- return $ reads $ BS.unpack o
+ return (BS.pack a, BS.pack x)
+ else do
+ ('\"',x) <- BS.uncons x
+ return (a, x)
+
+
+-- | Either a string produced by show, or a isAlphaNum terminated chunk
+readShortString :: BString -> Maybe (BString, BString)
+readShortString x | Just ('\"',_) <- BS.uncons x = readShowString x
+ | otherwise = Just $ BS.span isAlphaNum x
+
+
+-- | Either a space terminated chunk, or a quote terminated chunk
+readQuoteString :: BString -> Maybe (BString, BString)
+readQuoteString x | Just ('\"',x) <- BS.uncons x = do
+ (a,x) <- return $ BS.break (== '\"') x
+ ('\"',x) <- BS.uncons x
+ return (a, BS.dropWhile isSpace x)
+readQuoteString x = do
+ (a,x) <- return $ BS.break (== ' ') x
+ return (a, BS.dropWhile isSpace x)
+
diff --git a/src/Console/Search.hs b/src/Console/Search.hs
--- a/src/Console/Search.hs
+++ b/src/Console/Search.hs
@@ -22,7 +22,7 @@
["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 = querySuggestions dbs q
+ let sug = suggestions dbs q
when (isJust sug) $
putStrLn $ showTag $ fromJust sug
verbose <- isLoud
diff --git a/src/General/Base.hs b/src/General/Base.hs
--- a/src/General/Base.hs
+++ b/src/General/Base.hs
@@ -31,6 +31,8 @@
thd3 (a,b,c) = c
+swap (a,b) = (b,a)
+
fromLeft (Left x) = x
fromRight (Right x) = x
@@ -101,3 +103,8 @@
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
diff --git a/src/General/System.hs b/src/General/System.hs
--- a/src/General/System.hs
+++ b/src/General/System.hs
@@ -69,3 +69,7 @@
exitMessage :: [String] -> IO a
exitMessage msg = putStr (unlines msg) >> exitFailure
+
+
+getEnvVar :: String -> IO (Maybe String)
+getEnvVar x = catch (fmap Just $ getEnv x) (const $ return Nothing)
diff --git a/src/General/Web.hs b/src/General/Web.hs
--- a/src/General/Web.hs
+++ b/src/General/Web.hs
@@ -92,14 +92,10 @@
-- However, it does always set REQUEST_URI.
cgiVariable :: IO (Maybe String)
cgiVariable = do
- str <- envVariable "QUERY_STRING"
+ str <- getEnvVar "QUERY_STRING"
if isJust str
then return str
- else fmap (fmap $ const "") $ envVariable "REQUEST_URI"
-
-
-envVariable :: String -> IO (Maybe String)
-envVariable x = catch (fmap Just $ getEnv x) (const $ return Nothing)
+ else fmap (fmap $ const "") $ getEnvVar "REQUEST_URI"
cgiArgs :: IO (Maybe Args)
diff --git a/src/Hoogle.hs b/src/Hoogle.hs
--- a/src/Hoogle.hs
+++ b/src/Hoogle.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-- | The Hoogle API. To perform a search you call 'search' with a 'Database' (obtained by 'loadDatabase') and a
-- 'Query' (obtained by 'parseQuery').
@@ -7,20 +6,19 @@
TagStr(..), showTagText, showTagANSI, showTagHTML, showTagHTMLWith,
H.ParseError(..),
URL,
- Language(..),
+ H.Language(..),
-- * Database
Database, loadDatabase, saveDatabase, createDatabase, showDatabase,
-- * Query
- Query(..), H.Scope(..), parseQuery, H.renderQuery, H.isBlankQuery,
- queryDatabases, querySuggestions, queryCompletions,
+ Query, parseQuery, H.renderQuery,
+ H.queryDatabases, H.queryPackages, H.querySetPackage,
-- * Score
Score, H.scoring,
-- * Search
- Result(..), search
+ Result(..), search, suggestions, completions
) where
import Data.Binary.Defer.Index
-import Data.Data
import General.Base
import General.System
@@ -36,10 +34,6 @@
import Hoogle.Score.All(Score)
--- | 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)
-
-- * Database
-- | A Hoogle database, containing a set of functions/items which can be searched. The 'Database' type is used
@@ -80,7 +74,7 @@
-- | 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
- :: Language -- ^ Which format the input definition is in.
+ :: 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'.
-> ([H.ParseError], Database) -- ^ A pair containing any parse errors present in the input definition, and the database ignoring any parse errors.
@@ -99,24 +93,10 @@
-- Hoogle.Query
-- | Parse a query for a given language, returning either a parse error, or a query.
-parseQuery :: Language -> String -> Either H.ParseError Query
+parseQuery :: H.Language -> String -> Either H.ParseError Query
parseQuery _ = H.parseQuery
--- | 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 x = if null ps then ["default"] else ps
- where ps = [p | H.PlusPackage p <- H.scope x]
--- | Given a query and a database optionally give a list of what the user might have meant.
-querySuggestions :: Database -> Query -> Maybe TagStr
-querySuggestions (Database dbs) q = H.suggestQuery dbs q
-
--- | Given a query data a database return a list of the possible completions for the search.
-queryCompletions :: Database -> String -> [String]
-queryCompletions x = H.completions (toDataBase x)
-
-
-- Hoogle.Search
-- Invariant: locations will not be empty
@@ -140,3 +120,11 @@
-- | Perform a search. The results are returned lazily.
search :: Database -> Query -> [(Score,Result)]
search (Database xs) q = map toResult $ H.search 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 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)
diff --git a/src/Hoogle/Language/Haskell.hs b/src/Hoogle/Language/Haskell.hs
--- a/src/Hoogle/Language/Haskell.hs
+++ b/src/Hoogle/Language/Haskell.hs
@@ -35,12 +35,11 @@
parseLine :: Int -> String -> Either ParseError ([Fact],[TextItem])
parseLine line x | "(##)" `isPrefixOf` x = Left $ parseErrorWith line 1 "Skipping due to HSE bug #206" "(##)"
parseLine line ('@':str) = case a of
- "entry" -> Right $ itemEntry $ dropWhile isSpace b
- "package" -> Right $ itemPackage $ dropWhile isSpace b
+ "entry" | b <- words b, b /= [] -> Right $ itemEntry b
+ "package" | [b] <- words b, b /= "" -> Right $ itemPackage b
_ -> Left $ parseErrorWith line 2 ("Unknown attribute: " ++ a) $ '@':str
where (a,b) = break isSpace str
-parseLine line x | a == "module" = Right $ itemModule $ split '.' $ dropWhile isSpace b
- where (a,b) = break isSpace x
+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
@@ -80,10 +79,9 @@
itemURL="http://hackage.haskell.org/package/" ++ x ++ "/",
itemDisp=Tags [emph "package",space,bold x]}
-itemEntry x = fact [] $ textItem{itemName=ab, itemKey=ab,
- itemDisp= if null b then bold a else Tags [emph a,space,bold b]}
- where (a,b) = second (dropWhile isSpace) $ break isSpace x
- ab = if null b then a else b
+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="",
diff --git a/src/Hoogle/Query/Parser.hs b/src/Hoogle/Query/Parser.hs
--- a/src/Hoogle/Query/Parser.hs
+++ b/src/Hoogle/Query/Parser.hs
@@ -28,10 +28,6 @@
optionBool p = (p >> return True) <|> return False
-joinQuery (Query a1 b1 c1) (Query a2 b2 c2) = Query (a1++a2) (b1 `mplus` b2) (c1++c2)
-joinQueries = foldr joinQuery blankQuery
-
-
---------------------------------------------------------------------
-- QUERY PARSEC
@@ -41,19 +37,19 @@
end f = do x <- f; eof; return x
names = do a <- many (flag <|> name)
- b <- option blankQuery (string "::" >> spaces >> types)
- let res@Query{names=names} = joinQuery (joinQueries a) b
+ 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
- name = (do x <- operator ; spaces ; return blankQuery{names=[x]})
+ name = (do x <- operator ; spaces ; return mempty{names=[x]})
<|>
(do xs <- keyword `sepBy1` (char '.') ; spaces
return $ case xs of
- [x] -> blankQuery{names=[x]}
- xs -> blankQuery{names=[last xs],scope=[PlusModule (init xs)]}
+ [x] -> mempty{names=[x]}
+ xs -> mempty{names=[last xs],scope=[PlusModule (init xs)]}
)
operator = between (char '(') (char ')') op <|> op
@@ -65,10 +61,10 @@
types = do a <- flags
b <- parsecTypeSig
c <- flags
- return $ joinQueries [a,blankQuery{typeSig=Just b},c]
+ return $ mconcat [a,mempty{typeSig=Just b},c]
- flag = try $ do x <- parseFlagScope ; spaces ; return x
- flags = fmap joinQueries $ many flag
+ flag = try $ do x <- parseFlagScope; spaces; return x
+ flags = fmap mconcat $ many flag
-- deal with the parsing of:
@@ -82,8 +78,8 @@
modname = keyword `sepBy1` (char '.')
modu <- modname
case modu of
- [x] -> return $ blankQuery{scope=[if isLower (head x) then aPackage x else aModule [x]]}
- xs -> return $ blankQuery{scope=[aModule xs]}
+ [x] -> return $ mempty{scope=[if isLower (head x) then aPackage x else aModule [x]]}
+ xs -> return $ mempty{scope=[aModule xs]}
keyword = do
diff --git a/src/Hoogle/Query/Type.hs b/src/Hoogle/Query/Type.hs
--- a/src/Hoogle/Query/Type.hs
+++ b/src/Hoogle/Query/Type.hs
@@ -2,8 +2,7 @@
module Hoogle.Query.Type where
-import Data.Maybe
-import Data.Data
+import General.Base
import Hoogle.Type.All
@@ -15,14 +14,10 @@
}
deriving (Data,Typeable,Show,Eq)
-
--- | Test if a query will result in a search being performed. A query which lists only scopes
--- (e.g. @+base@) will still be reported is blank.
-isBlankQuery :: Query -> Bool
-isBlankQuery query = null (names query) && isNothing (typeSig query)
-
-blankQuery :: Query
-blankQuery = Query [] Nothing []
+instance Monoid Query where
+ mempty = Query [] Nothing []
+ mappend (Query x1 x2 x3) (Query y1 y2 y3) =
+ Query (x1++y1) (x2 `mplus` y2) (x3++y3)
data Scope = PlusPackage String
@@ -31,5 +26,26 @@
| MinusModule [String]
deriving (Eq, Show, Read, Data, Typeable)
-isPlusModule (PlusModule _) = True; isPlusModule _ = False
-isMinusModule (MinusModule _) = True; isMinusModule _ = False
+
+-- | 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 x = if null ps then ["default"] else ps
+ where ps = [p | PlusPackage p <- scope x]
+
+
+-- | Return those packages which are explicitly excluded (paired with 'False')
+-- or included (paired with 'True') in the query.
+queryPackages :: Query -> [(Bool, String)]
+queryPackages = concatMap f . scope
+ where f (MinusPackage x) = [(False,x)]
+ f (PlusPackage x) = [(True ,x)]
+ f _ = []
+
+-- | 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) ++ [if b then PlusPackage x else MinusPackage x | Just b <- [b]]}
+ where f (MinusPackage y) = x /= y
+ f (PlusPackage y) = x /= y
+ f _ = True
diff --git a/src/Hoogle/Search/Results.hs b/src/Hoogle/Search/Results.hs
--- a/src/Hoogle/Search/Results.hs
+++ b/src/Hoogle/Search/Results.hs
@@ -70,10 +70,14 @@
f [] act = id
f xs act = filter (act xs . fromLink . resultEntry)
- mods = filter (\x -> isPlusModule x || isMinusModule x) $ scope q
+ mods = filter isMod $ scope q
pkgs = [x | MinusPackage x <- scope q]
+ isMod PlusModule{} = True
+ isMod MinusModule{} = True
+ isMod _ = False
+
-- pkgs is a non-empty list of MinusPackage values
correctPackage :: [String] -> Entry -> Bool
correctPackage pkgs x = null myPkgs || any (maybe True (`notElem` pkgs)) myPkgs
@@ -85,7 +89,7 @@
correctModule mods x = null myMods || any (maybe True (f base mods . split '.')) myMods
where
myMods = map (fmap (entryName . fromLink) . listToMaybe . drop 1 . snd) $ entryLocations x
- base = isMinusModule $ head mods
+ base = case head mods of MinusModule{} -> True; _ -> False
f z [] y = z
f z (PlusModule x:xs) y | doesMatch x y = f True xs y
diff --git a/src/Hoogle/Type/All.hs b/src/Hoogle/Type/All.hs
--- a/src/Hoogle/Type/All.hs
+++ b/src/Hoogle/Type/All.hs
@@ -3,6 +3,7 @@
import Hoogle.Type.Documentation 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
diff --git a/src/Hoogle/Type/Language.hs b/src/Hoogle/Type/Language.hs
new file mode 100644
--- /dev/null
+++ b/src/Hoogle/Type/Language.hs
@@ -0,0 +1,11 @@
+{-# 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)
diff --git a/src/Recipe/Keyword.hs b/src/Recipe/Keyword.hs
--- a/src/Recipe/Keyword.hs
+++ b/src/Recipe/Keyword.hs
@@ -14,7 +14,7 @@
translate :: String -> String
translate src = unlines $ keywordPrefix ++ items
- where items = concatMap keywordFormat $ partitions (~== "
") $
+ where items = concatMap keywordFormat $ drop 1 $ partitions (~== "") $
takeWhile (~/= ""
- ," "
+ ," "
," "
,"![Hoogle](" ++ resources ++ "/hoogle.png)
" ++
""
- ," "
+ ," "
," "
,""
]
@@ -50,7 +55,7 @@
footer =
["