packages feed

hoogle 4.0.0.2 → 4.0.0.3

raw patch · 5 files changed

+88/−29 lines, 5 files

Files

hoogle.cabal view
@@ -1,7 +1,7 @@ cabal-version:      >= 1.1.4 build-type:         Simple name:               hoogle-version:            4.0.0.2+version:            4.0.0.3 license:            GPL license-file:       LICENSE category:           Development
src/CmdLine/Test.hs view
@@ -21,7 +21,7 @@   -- LineNo Query Results-data Test = Test Int String Query [[String]]+data Test = Test Int String Query [String] [[String]]             deriving Show  @@ -29,7 +29,8 @@ parseTest line str | "@test " `isPrefixOf` str =     case reads $ drop 5 str of         [(x,rest)] -> case parseQuery x of-            Right q -> Just $ Test line x q (map (split ',') $ words rest)+            Right q -> let (no,yes) = partition ("!" `isPrefixOf`) $ words rest+                       in Just $ Test line x q (map tail no) (map (split ',') yes)             _ -> err         _ -> err     where err = error $ "Couldn't parse @test on line " ++ show line@@ -37,18 +38,20 @@   runTest :: DataBase -> Test -> Bool-runTest db (Test _ _ q ans) =-        ordered (group $ map resultScore res) &&       -- all results are in order-        all (`elem` map fst items) (concat ans) &&     -- all items are present-        ordered (map (map (`lookupJust` items)) ans)   -- all items are in order+runTest db (Test _ _ q bad ans) =+        ordered (group $ map resultScore res) &&         -- all results are in order+        all (`elem` map fst items) (concat ans) &&       -- all items are present+        ordered (map (map (`lookupJust` items)) ans) &&  -- all items are in order+        all (`notElem` map fst items) bad                -- all the bad items are absent     where         res = searchAll [db] q         items = map (entryName . fromLink . resultEntry &&& resultScore) res          ordered ((x:xs):(y:ys):zs) = x < y && all (== x) xs && ordered ((y:ys):zs)         ordered [x:xs] = all (== x) xs+        ordered [] = True   failedTest :: Test -> String-failedTest (Test line str _ _) = "Line " ++ show line ++ ", " ++ str+failedTest (Test line str _ _ _) = "Line " ++ show line ++ ", " ++ str
src/Hoogle/DataBase/TypeSearch/Result.hs view
@@ -67,7 +67,8 @@         -- must take one element from 0         -- must use res from ind         path :: [[ResultArg]]-        path = f i IntSet.empty $ zip [0..] info+        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)
src/Web/Action.hs view
@@ -47,9 +47,9 @@ runQuery dbs CmdQuery{queryText = text, query = Left err} =     ["<h1><b>Parse error in user query</b></h1>"     ,"<p>"-    ,"  Query: <tt>" +? pre ++ "<span id='error'>" +? post2 ++ "</span></tt><br/>"+    ,"  Query: <tt>" +& pre ++ "<span id='error'>" +& post2 ++ "</span></tt><br/>"     ,"</p><p>"-    ,"  Error: " +? drop 1 (dropWhile (/= ':') $ show err) ++ "<br/>"+    ,"  Error: " +& drop 1 (dropWhile (/= ':') $ show err) ++ "<br/>"     ,"</p><p>"     ,"  For information on what queries should look like, see the user manual."     ,"</p>"@@ -67,28 +67,79 @@     ]  -runQuery dbs CmdQuery{query = Right q} =+runQuery dbs cq@CmdQuery{query = Right q, queryFlags = flags} =     ["<h1>Searching for " ++ qstr ++ "</h1>"] ++     ["<p>" ++ showTagHTML sug ++ "</p>" | Just sug <- [suggestQuery dbs q]] ++     if null res then         ["<p>No results found</p>"]-    else-        ["<table>"] ++ map (f . renderResult) res ++ ["</table>"]+    else -- error $ show (length res, length pre, length now, length post) -+        ["<table>"] +++        concatMap renderRes pre +++        insertMore (concatMap renderRes now) +++        [moreResults | not $ null post] +++        ["</table>"]     where-        res = searchRange (rangeStartCount 0 25) dbs q-        f (m,r,v) = "<tr><td class='mod'>" ++ maybe "" showModule m ++-                    "</td><td>" ++ showTagHTML r ++ "</td></tr>"+        start = headDef 0 [i-1 | Start i <- flags]+        count = headDef 20 [n | Count n <- flags]+        res = searchRange (rangeStartCount 0 (start+count+1)) dbs q+        (pre,res2) = splitAt start res+        (now,post) = splitAt count res2 -        qstr = unwords $ ["<b>" ++ n ++ "</b>" | n <- names q] +++        moreResults = "<tr><td></td><td><a href='" ++ urlMore ++ "' class='more'>Show more results</a></td></tr>"+        urlMore = "?q=" +% queryText cq ++ "&start=" ++ show (start+count+1) ++ "#more"++        qstr = unwords $ ["<b>" +& n ++ "</b>" | n <- names q] ++                ["::" | names q /= [] && isJust (typeSig q)] ++                [showTagHTML (renderEntryText view $ renderTypeSig t) | Just t <- [typeSig q]]         view = [ArgPosNum i i | i <- [0..10]]  +-- insert <a name=more> where you can+insertMore :: [String] -> [String]+insertMore [] = []+insertMore (x:xs) = f x : xs+    where+        f ('>':xs) | not $ "<td" `isPrefixOf` xs = "><a name='more'></a>" ++ xs+        f (x:xs) = x : f xs+        f [] = [] -a +? b = a ++ escapeHTML b +renderRes :: Result -> [String]+renderRes r =+        [tr $ td "mod" modname ++ td "" (href urlItem $ showTagHTMLWith url text)+        ,tr $ td "pkg" pkgname ++ td "doc" doc]+    where+        pkg = liftM (fromLink . modulePackage . fromLink) $ entryModule $ fromLink $ resultEntry r+    +        (modu,text,_) = renderResult r+        modname = maybe "" (href urlModule . showModule) modu+        pkgname = maybe "" (href urlPkg . packageName) pkg+        doc = takeWhile (/= '\n') $ showTagHTML $ renderHaddock $ entryDocs $ fromLink $ resultEntry r +        urlPkg = "http://hackage.haskell.org/packages/archive/" +? maybe "" packageName pkg +? "/latest/doc/html/"+        urlModule = urlPkg +? concat (intersperse "-" $ fromMaybe [] modu) +? ".html"+        urlItem = urlModule +? "#v:" +? escapeHTML (entryName $ fromLink $ resultEntry r)++        url (TagHyperlink _ x) = Just $ "</a><a href='" +& urlItem ++ "'>" ++ showTagHTML x +++                                        "</a><a class='dull' href='" +& urlItem ++ "'>"+        url _ = Nothing++tr x = "<tr>" ++ x ++ "</tr>"+td c x = "<td" ++ (if null c then "" else " class='" ++ c ++ "'") ++ ">" ++ x ++ "</td>"+href url x = if null url then x else "<a class='dull' href='" ++ url ++ "'>" ++ x ++ "</a>"+++-- | Only append strings if neither one is empty+(+?) :: String -> String -> String+a +? b = if null a || null b then [] else a ++ b++-- | Escape the second argument before appending+(+&) :: String -> String -> String+a +& b = a ++ escapeHTML b++(+%) = (+&) -- CGI query string escaping++ escapeHTML = concatMap f     where         f '\"' = "&quot;"@@ -97,9 +148,16 @@         f x = [x]  -showTagHTML (Str x) = escapeHTML x-showTagHTML (Tags xs) = concatMap showTagHTML xs-showTagHTML (TagBold x) = "<b>" ++ showTagHTML x ++ "</b>"-showTagHTML (TagUnderline x) = "<i>" ++ showTagHTML x ++ "</i>"-showTagHTML (TagHyperlink url x) = "<a href=\"" +? url ++ "\">" ++ showTagHTML x ++ "</a>"-showTagHTML (TagColor i x) = "<span class='c" ++ show i ++ "'>" ++ showTagHTML x ++ "</span>"+showTagHTML = showTagHTMLWith (const Nothing)+++showTagHTMLWith :: (TagStr -> Maybe String) -> TagStr -> String+showTagHTMLWith f x = g x+    where+        g x | isJust (f x) = fromJust $ f x+        g (Str x) = escapeHTML x+        g (Tags xs) = concatMap g xs+        g (TagBold x) = "<b>" ++ showTagHTML x ++ "</b>"+        g (TagUnderline x) = "<i>" ++ showTagHTML x ++ "</i>"+        g (TagHyperlink url x) = "<a href=\"" +& url ++ "\">" ++ showTagHTML x ++ "</a>"+        g (TagColor i x) = "<span class='c" ++ show i ++ "'>" ++ showTagHTML x ++ "</span>"
src/Web/Page.hs view
@@ -18,9 +18,6 @@  links =     ["<div id='links'>"-    ,"  <!--[if IE]><span style='display:none;'><![endif]-->"-    ,"    <a href='javascript:addHoogle()'>Firefox plugin</a> |"-    ,"  <!--[if IE]></span><![endif]-->"     ,"  <a href='http://www.haskell.org/haskellwiki/Hoogle'>Manual</a> |"     ,"  <a href='http://www.haskell.org/'>haskell.org</a>"     ,"</div>"@@ -31,7 +28,7 @@     ,"  <a id='logo' href='http://haskell.org/hoogle/'>" ++          "<img src='res/hoogle.png' alt='Hoogle' />" ++        "</a>"-    ,"  <input name='q' id='text' type='text' value=\"" ++ query ++ "\" />"+    ,"  <input name='q' id='q' type='text' value=\"" ++ query ++ "\" />"     ,"  <input id='submit' type='submit' value='Search' />"     ,"</form>"     ]