hoogle 4.1.3 → 4.1.4

raw patch · 17 files changed

+222/−108 lines, 17 filesdep +unixdep ~haskell-src-extsbinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies added: unix

Dependency ranges changed: haskell-src-exts

API changes (from Hackage documentation)

Files

• datadir/resources/hoogle.css +59/−13
• datadir/resources/hoogle.js +66/−26
• datadir/resources/less_small.png binary
• datadir/resources/more_small.png binary
• hoogle.cabal +6/−3
• src/CmdLine/Type.hs +1/−1
• src/General/System.hs +15/−1
• src/General/Web.hs +7/−5
• src/Hoogle.hs +1/−1
• src/Hoogle/DataBase/SubstrSearch.hs +6/−18
• src/Hoogle/Query/Suggest.hs +1/−1
• src/Hoogle/Type/TagStr.hs +1/−5
• src/Recipe/All.hs +1/−1
• src/Web/All.hs +3/−2
• src/Web/Page.hs +17/−12
• src/Web/Response.hs +34/−17
• src/Web/Server.hs +4/−2

@@ -29,20 +29,20 @@     margin-top: 5px; } -input {-    font-size: 16px;-    margin-top: 22px;-    vertical-align: top;-}- form {     margin-bottom: 0px; } -form a:hover {-    background-color: white;+#logo img {+    vertical-align: bottom; } +#hoogle, #submit {+    font-size: 16px;+    margin-bottom: 16px;+    vertical-align: bottom;+}+ #hoogle {     width: 300px;     margin-right: 5px;@@ -56,11 +56,56 @@   /********************************************************************+*  LEFT - EXTRA SUGGESTIONS+*/++#left {+    float: left;+    width: 140px;+    margin-top: 7px;+    margin-left: 10px;+    font-size: 13px;+}++#left ul {+    padding: 0px;+    margin: 0px;+}++#left li {+    list-style-type: none;+    margin-bottom: 7px;+    white-space: nowrap;+    display: block;+}++#left a {+    text-decoration: none;+    background-repeat: no-repeat;+}++#left .plus {+    color: #0E7700;+    padding-right: 16px;+    background-image: url(more_small.png);+    background-position: center right;+}++#left .minus {+    color: #770E00;+    padding-left: 16px;+    background-image: url(less_small.png);+    background-position: center left;+}+++/******************************************************************** *  BOTTOM - COPYRIGHT MESSAGE */  #footer {     text-align: center;+    font-size: 13px; }  @@ -69,7 +114,6 @@ */  h1 {-    font-size: 13px;     padding: 5px;     margin-top: 0px;     font-weight: normal;@@ -77,11 +121,14 @@        to make type searching visisble */     background-color: #e4e4e4;     border-top: 1px solid #999;+    text-indent: 165px;+    font-size: 16px; }  p {-    padding-left: 20px;-    padding-right: 20px;+    margin-left: 170px;+    margin-right: 20px;+    font-size: 16px; }  @@ -102,10 +149,9 @@     margin-top: 20px;     margin-bottom: 20px;     padding: 3px;-    width: 300px;+    width: 400px;     border: 2px solid #cc0;     background-color: #ffc;-    font-size: 10pt;     text-align: left; } 

@@ -1,43 +1,83 @@ +var instant = false; // should we search on key presses+++/////////////////////////////////////////////////////////////////////+// SEARCHING++var currentSearch; // String+var oldSearches = cache(100);+ $(function(){-    if (window.external && ("AddSearchProvider" in window.external))-        document.getElementById("plugin").style.display = "";+    currentSearch = $("#hoogle").focus().keyup(searchBoxChange).val();+}); -    $("#hoogle").focus();-    if ($.getQueryString('ajax'))+function searchBoxChange()+{+    if (!instant) return;+    var txt = $("#hoogle");+    var bod = $("#body");+    var now = txt.val();+    if (now == currentSearch) return; else currentSearch = now;+    var old = oldSearches.ask(now);+    if (old != undefined)+        bod.html(old);+    else     {-        var c = cache(100);-        var last = $("#hoogle").val();--        $("#hoogle").keyup(function(){-            var now = $("#hoogle").val();-            if (now == last) return; else last = now;-            var old = c.ask(now);-            if (old != undefined)-                $("#body").html(old);-            else-            {-                $.ajax({-                    url: '?',-                    data: {mode:'ajax', hoogle:now},-                    dataType: 'html',-                    complete: function(s){return function(e){-                        c.add(s,e.responseText);-                        if ($("#hoogle").val() == s)-                            $("#body").html(e.responseText);-                    }}(now)-                });-            }+        $.ajax({+            url: '?',+            data: {mode:'ajax', hoogle:now},+            dataType: 'html',+            complete: function(s){return function(e){+                oldSearches.add(s,e.responseText);+                if (txt.val() == s)+                    bod.html(e.responseText);+            }}(now)         });     }+}+++/////////////////////////////////////////////////////////////////////+// INSTANT++$(function(){+    setInstant($.getQueryString('ajax') == "1" || $.cookie("instant") == "1");+    $("#instant").css("display",""); }); +function setInstant(x)+{+    instant = x == undefined ? !instant : x ? true : false;+    $("#instantVal").html(instant ? "on" : "off");+    if (instant)+    {+        $.cookie("instant","1",{expires:365});+        searchBoxChange();+    }+    else+        $.cookie("instant",null);+}+++/////////////////////////////////////////////////////////////////////+// SEARCH PLUGIN++$(function(){+    if (window.external && ("AddSearchProvider" in window.external))+        $("#plugin").css("display","");+});+ function searchPlugin() {     var l = document.location;     var url = l.protocol + "//" + l.hostname + l.pathname + $("link[rel=search]").attr("href");     window.external.AddSearchProvider(url); }+++/////////////////////////////////////////////////////////////////////+// DOCUMENTATION  function docs(i) {

binary file changed (absent → 201 bytes)

binary file changed (absent → 202 bytes)

@@ -1,13 +1,13 @@ cabal-version:      >= 1.6 build-type:         Simple name:               hoogle-version:            4.1.3+version:            4.1.4 license:            GPL license-file:       docs/LICENSE category:           Development author:             Neil Mitchell <ndmitchell@gmail.com> maintainer:         Neil Mitchell <ndmitchell@gmail.com>-copyright:          Neil Mitchell 2004-2010+copyright:          Neil Mitchell 2004-2011 synopsis:           Haskell API Search description:     Hoogle is a Haskell API search engine, which allows you to@@ -37,7 +37,10 @@         parsec == 2.1.*,         transformers == 0.2.*,         uniplate == 1.6.*,-        haskell-src-exts == 1.9.*+        haskell-src-exts >= 1.9 && < 1.11++    if !os(mingw32)+        build-depends: unix      exposed-modules:         Hoogle

@@ -46,7 +46,7 @@  cmdLineMode = cmdArgsMode $ modes [search_ &= auto,test,server,dump,rank,combine,convert,dataa]     &= verbosity &= program "hoogle"-    &= summary ("Hoogle v" ++ showVersion version ++ ", (C) Neil Mitchell 2004-2010\nhttp://haskell.org/hoogle")+    &= summary ("Hoogle v" ++ showVersion version ++ ", (C) Neil Mitchell 2004-2011\nhttp://haskell.org/hoogle")  search_ = Search     {web = def &= help "Operate as a web tool"

@@ -10,7 +10,6 @@ import System.IO as X import System.Mem as X (performGC) - import General.Base import qualified Control.Exception as E @@ -18,11 +17,26 @@ import GHC.IO.Handle(hDuplicate,hDuplicateTo) #endif +#ifndef mingw32_HOST_OS+import System.Posix(setFileCreationMask)+#else+setFileCreationMask :: Int -> IO Int+setFileCreationMask _ = return 0+#endif ++ withDirectory dir cmd = E.bracket     (do x <- getCurrentDirectory; setCurrentDirectory dir; return x)     setCurrentDirectory     (const cmd)+++withModeGlobalRead :: IO () -> IO ()+withModeGlobalRead act = E.bracket+    (setFileCreationMask 0o022)+    (const act)+    (\x -> setFileCreationMask x >> return ())   -- FIXME: This could use a lot more bracket calls!

@@ -6,10 +6,9 @@  module General.Web(     responseOk, responseBadRequest, responseNotFound, responseError,-    filePathToURL, combineURL, escapeURL, (++%), unescapeURL,+    URL, filePathToURL, combineURL, escapeURL, (++%), unescapeURL,     escapeHTML, (++&), htmlTag,-    cgiArgs,-    parseHttpQueryArgs+    Args, cgiArgs, parseHttpQueryArgs     ) where  import General.System@@ -26,6 +25,9 @@ responseError x = Response (5,0,0) "Internal Server Error" [] $ "Internal server error: " ++ x  +type Args = [(String, String)]++ --------------------------------------------------------------------- -- HTML STUFF @@ -100,7 +102,7 @@ envVariable x = catch (fmap Just $ getEnv x) (const $ return Nothing)  -cgiArgs :: IO (Maybe [(String, String)])+cgiArgs :: IO (Maybe Args) cgiArgs = do     x <- cgiVariable     return $ case x of@@ -111,7 +113,7 @@ --------------------------------------------------------------------- -- HTTP STUFF -parseHttpQueryArgs :: String -> [(String, String)]+parseHttpQueryArgs :: String -> Args parseHttpQueryArgs xs = mapMaybe (f . splitPair "=") $ splitList "&" xs     where f Nothing = Nothing           f (Just (a,b)) = Just (unescapeURL a, unescapeURL b)

@@ -11,7 +11,7 @@     -- * Database     Database, loadDatabase, saveDatabase, createDatabase, showDatabase,     -- * Query-    Query, parseQuery, H.renderQuery, H.isBlankQuery,+    Query(..), H.Scope(..), parseQuery, H.renderQuery, H.isBlankQuery,     queryDatabases, querySuggestions, queryCompletions,     -- * Score     Score, H.scoring,

@@ -28,20 +28,13 @@ {- Description: -The substring search is an array of (key,value) pairs. The keys are sorted case-sensitively.--To do a search we binary chop to find the range where the exact prefixes lie,-then we binary chop to find the range where the inexact prefixes lie, then we-scan linearly to find all substrings.- 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 :: BS.ByteString -- all the bytestrings, lowercase, sorted-    ,lens :: BS.ByteString -- a list of lengths, 0 means the string was identical to the previous one+    {text :: BS.ByteString -- all the bytestrings, in preference order+    ,lens :: BS.ByteString -- a list of lengths     ,inds :: Int -> a -- a way of retrieving each index     } @@ -53,18 +46,16 @@     (BS.pack $ map fromIntegral ls2)     (is !!)     where-        (ts,is) = unzip $ sortBy (comparing fst) $ map (first $ map toLower) xs+        (ts,is) = unzip $ map (first $ map toLower) xs         (ts2,ls2) = f "" ts -        f x (y:ys) | x == y = second (0:) $ f x ys-                   | otherwise = first (y:) $ second (length y:) $ f y ys+        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-    ,sLast :: !(Maybe TextMatch) -- the last result     ,sPrefix :: ![(a,EntryView,Score)] -- the prefixes     ,sInfix :: ![(a,EntryView,Score)] -- the infixes     }@@ -76,12 +67,9 @@         view = FocusOn y         match = bsMatch (BSC.pack $ map toLower y)         sN = BS.foldl f s0 $ lens x-        s0 = S 0 (text x) Nothing [] []+        s0 = S 0 (text x) [] [] -        f s 0 = addCount $ case sLast s of-            Nothing -> s-            Just x -> addMatch x s-        f s ii = addCount $ moveFocus i $ maybe id addMatch t $ s{sLast=t}+        f s ii = addCount $ moveFocus i $ maybe id addMatch t s             where t = match i $ BS.unsafeTake i $ sFocus s                   i = fromIntegral ii 

@@ -41,7 +41,7 @@   didYouMean :: Query -> TagStr-didYouMean q = Tags [TagBold $ Str "Did you mean: ", TagLink ("query:" ++ s) $ Str s]+didYouMean q = Tags [TagBold $ Str "Did you mean: ", TagLink "" $ Str s]     where s = showTagText $ renderQuery q  

@@ -120,11 +120,7 @@         g (Tags xs) = concatMap g xs         g (TagBold x) = htmlTag "b" $ showTagHTML x         g (TagEmph x) = htmlTag "i" $ showTagHTML x-        -- FIXME: this is overly specific!-        g (TagLink "" x) = g (TagLink url x)-            where str = showTagText x-                  url = if "http:" `isPrefixOf` str then str else "?hoogle=" ++% str-        g (TagLink url x) = "<a href=\"" ++& url ++ "\">" ++ showTagHTML x ++ "</a>"+        g (TagLink url x) = "<a href=\"" ++& (if null url then showTagText x else url) ++ "\">" ++ showTagHTML x ++ "</a>"         g (TagColor i x) = "<span class='c" ++ show i ++ "'>" ++ showTagHTML x ++ "</span>"          nbsp (' ':' ':xs) = " &nbsp;" ++ nbsp xs

@@ -16,7 +16,7 @@  -- CmdLine is guaranteed to be a constructor of type Data recipes :: CmdLine -> IO ()-recipes opt = do+recipes opt = withModeGlobalRead $ do     hSetBuffering stdout NoBuffering     createDirectoryIfMissing True $ datadir opt     withDirectory (datadir opt) $ do

@@ -10,7 +10,8 @@ action :: CmdLine -> IO () action q@Server{} = server q --- would like to use datadir, but not sure how+-- FIXME: Should use datadir, but not sure how+-- FIXME: Only server will preserve extra flags action q = do-    res <- response "datadir/resources" q+    res <- response "datadir/resources" [] q     putStrLn $ intercalate "\n" $ map show (rspHeaders res) ++ ["",rspBody res]

@@ -1,10 +1,14 @@ -module Web.Page(header, footer, welcome) where+module Web.Page(searchLink, header, footer, welcome) where  import General.Web import General.Util  +searchLink :: Args -> String -> URL+searchLink extra x = "?" ++ concat [a ++ "=" ++% b ++ "&" | (a,b) <- extra, a /= "hoogle"] ++ "hoogle=" ++% x++ header resources query =     ["<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"     ,"<html xmlns='http://www.w3.org/1999/xhtml' xml:lang='en' lang='en'>"@@ -15,6 +19,7 @@     ,"     <link type='image/png' rel='icon' href='" ++ resources ++ "/favicon.png' />"     ,"     <link type='application/opensearchdescription+xml' rel='search' href='" ++ resources ++ "/search.xml' title='Hoogle' />"     ,"     <script type='text/javascript' src='" ++ resources ++ "/jquery-1.4.2.js'> </script>"+    ,"     <script type='text/javascript' src='" ++ resources ++ "/jquery.cookie.js'> </script>"     ,"     <script type='text/javascript' src='" ++ resources ++ "/hoogle.js'> </script>"     ,"  </head>"     ,"  <body>"@@ -24,6 +29,8 @@  links =     ["<div id='links'>"+    ,"  <span id='instant' style='display:none;'><a href='javascript:setInstant()'>" +++          "Instant is <span id='instantVal'>off</span> (&beta;)</a> |</span>"     ,"  <span id='plugin' style='display:none;'><a href='javascript:searchPlugin()'>Search plugin</a> |</span>"     ,"  <a href='http://www.haskell.org/haskellwiki/Hoogle'>Manual</a> |"     ,"  <a href='http://www.haskell.org/'>haskell.org</a>"@@ -31,27 +38,25 @@     ]  search resources query =-    ["<form action='.' method='get'>"-    ,"  <div id='search'>"-    ,"    <a id='logo' href='http://haskell.org/hoogle/'>" ++-           "<img src='" ++ resources ++ "/hoogle.png' width='160' height='58' alt='Hoogle' />" ++-         "</a>"-    ,"    <input name='hoogle' id='hoogle' type='text' autocomplete='off' value=\"" ++ query ++ "\" />"-    ,"    <input id='submit' type='submit' value='Search' />"-    ,"  </div>"+    ["<form action='.' method='get' id='search'>"+    ,"  <a id='logo' href='http://haskell.org/hoogle/'>" +++         "<img src='" ++ resources ++ "/hoogle.png' width='160' height='58' alt='Hoogle' />" +++       "</a>"+    ,"  <input name='hoogle' id='hoogle' type='text' autocomplete='off' value=\"" ++ query ++ "\" />"+    ,"  <input id='submit' type='submit' value='Search' />"     ,"</form>"     ]   footer =     ["</div>"-    ,"    <p id='footer'>&copy; <a href='http://community.haskell.org/~ndm/'>Neil Mitchell</a> 2004-2010</p>"+    ,"    <p id='footer'>&copy; <a href='http://community.haskell.org/~ndm/'>Neil Mitchell</a> 2004-2011</p>"     ,"  </body>"     ,"</html>"     ]  -welcome =+welcome extra =     ["<h1><b>Welcome to Hoogle</b></h1>"     ,"<p>"     ,"  Hoogle is a Haskell API search engine, which allows you to search many standard Haskell libraries"@@ -77,4 +82,4 @@     ,"</p>"     ]     where-        search x = "<a href='?hoogle=" ++% x ++ "'>" ++& x ++ "</a><br/>"+        search x = "<a href='" ++ searchLink extra x ++ "'>" ++& x ++ "</a><br/>"

@@ -18,9 +18,9 @@  logFile = "log.txt" --response :: FilePath -> CmdLine -> IO (Response String)-response resources q = do+-- extra is a hack, should be replaced with a local cookie, until it becomes the default+response :: FilePath -> Args -> CmdLine -> IO (Response String)+response resources extra q = do     logMessage q     let response x = responseOk [Header HdrContentType x] @@ -28,7 +28,7 @@             dbs <- if isRight $ queryParsed q                    then fmap snd $ loadQueryDatabases (databases q) (fromRight $ queryParsed q)                    else return mempty-            return $ runQuery ajax dbs q+            return $ runQuery extra ajax dbs q      case webmode q of         Just "ajax" -> do@@ -60,8 +60,8 @@ runSuggest _ = return ""  -runQuery :: Bool -> Database -> CmdLine -> [String]-runQuery ajax dbs Search{queryParsed = Left err} =+runQuery :: Args -> Bool -> Database -> CmdLine -> [String]+runQuery extra ajax dbs Search{queryParsed = Left err} =     ["<h1><b>Parse error in user query</b></h1>"     ,"<p>"     ,"  Query: <span id='error'>" ++ showTagHTMLWith f (parseInput err) ++ "</span>"@@ -77,13 +77,14 @@         f _ = Nothing  -runQuery ajax dbs q | isBlankQuery $ fromRight $ queryParsed q = welcome+runQuery extra ajax dbs q | isBlankQuery $ fromRight $ queryParsed q = welcome extra  -runQuery ajax dbs cq@Search{queryParsed = Right q} =+runQuery extra ajax dbs cq@Search{queryParsed = Right q, queryText = qt} =     (if prefix then-        ["<h1>Searching for " ++ qstr ++ "</h1>"] ++-        ["<p>" ++ showTagHTML (transform qurl sug) ++ "</p>" | Just sug <- [querySuggestions dbs q]] +++        ["<h1>" ++ qstr ++ "</h1>"] +++        ["<div id='left'>" ++ also ++ "</div>" | not $ null pkgs] +++        ["<p>" ++ showTag extra sug ++ "</p>" | Just sug <- [querySuggestions dbs q]] ++         if null res then             ["<p>No results found</p>"]         else@@ -96,18 +97,26 @@         start2 = maybe 0 (subtract 1 . max 0) $ start cq         count2 = maybe 20 (max 1) $ count cq -        res = [renderRes i (i /= 0 && i == start2 && prefix) x | (i,(_,x)) <- zip [0..] $ search dbs q]+        src = search dbs q+        res = [renderRes extra i (i /= 0 && i == start2 && prefix) x | (i,(_,x)) <- zip [0..] src]         (pre,res2) = splitAt start2 res         (now,post) = splitAt count2 res2 -        urlMore = "?hoogle=" ++% queryText cq ++ "&start=" ++ show (start2+count2+1) ++ "#more"+        also = "<ul><li><b>Packages</b></li>" ++ concatMap f (take 5 pkgs) ++ "</ul>"+        f x | PlusPackage x `elem` scope q =+                let q2 = showTagText $ renderQuery $ q{scope = filter (/= PlusPackage x) $ scope q} in+                "<li><a class='minus' href='" ++ searchLink extra (q2) ++ "'>" ++ x ++ "</a></li>"+            | otherwise =+                "<li><a class='minus' href='" ++ searchLink extra (qt ++ " -" ++ x) ++ "'></a>" +++                "<a class='plus' href='" ++ searchLink extra (qt ++ " +" ++ x) ++ "'>" ++ x ++ "</a></li>"+        pkgs = nub [x | (_, (_,x):_)  <- concatMap (locations . snd) $ take (start2+count2) src]++        urlMore = searchLink extra qt ++ "&start=" ++ show (start2+count2+1) ++ "#more"         qstr = showTagHTML (renderQuery q)-        qurl (TagLink url x) | "query:" `isPrefixOf` url = TagLink ("?hoogle=" ++% drop 6 url) x-        qurl x = x  -renderRes :: Int -> Bool -> Result -> [String]-renderRes i more Result{..} =+renderRes :: Args -> Int -> Bool -> Result -> [String]+renderRes extra i more Result{..} =         ["<a name='more'></a>" | more] ++         ["<div class='ans'>" ++ href selfUrl (showTagHTMLWith url self) ++ "</div>"] ++         ["<div class='from'>" ++ intercalate ", " [unwords $ zipWith (f u) [1..] ps | (u,ps) <- locations] ++ "</div>" | not $ null locations] ++@@ -119,7 +128,7 @@          docs2 = ("<div id='d" ++ show i ++ "' class='shut'>" ++                    "<a class='docs' onclick='return docs(" ++ show i ++ ")' href='" ++& selfUrl ++ "'></a>") ++?-                   showTagHTML docs ++?+                   showTag extra docs ++?                "</div>"          url (TagBold x)@@ -132,3 +141,11 @@         g x = x          href url x = if null url then x else "<a class='dull' href='" ++& url ++ "'>" ++ x ++ "</a>"+++showTag :: Args -> TagStr -> String+showTag extra = showTagHTML . transform f+    where+        f (TagLink "" x) = TagLink (if "http:" `isPrefixOf` str then str else searchLink extra str) x+            where str = showTagText x+        f x = x

@@ -3,6 +3,7 @@ module Web.Server(server) where  import General.Base+import General.Util import General.Web import CmdLine.All import Web.Response@@ -61,8 +62,9 @@ talk :: CmdLine -> Request String -> IO (Response String) talk Server{..} Request{rqURI=URI{uriPath=path,uriQuery=query}}     | path `elem` ["/","/hoogle"] = do-        args <- cmdLineWeb $ parseHttpQueryArgs $ drop 1 query-        r <- response "/res" args{databases=databases}+        let args = parseHttpQueryArgs $ drop 1 query+        cmd <- cmdLineWeb args+        r <- response "/res" (reps ("mode","ajax") ("ajax","1") args) cmd{databases=databases}         return $ if local_ then fmap rewriteFileLinks r else r     | takeDirectory path == "/res" = serveFile True $ resources </> takeFileName path     | local_ && "/file/" `isPrefixOf` path = serveFile False $ drop 6 path