hoogle 4.1.4 → 4.1.5

raw patch · 19 files changed

+162/−150 lines, 19 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• datadir/resources/hoogle.css +7/−5
• datadir/resources/hoogle.js +11/−3
• hoogle.cabal +1/−1
• src/CmdLine/All.hs +4/−3
• src/CmdLine/Type.hs +32/−35
• src/Console/All.hs +1/−0
• src/Hoogle/DataBase/All.hs +2/−1
• src/Hoogle/DataBase/SubstrSearch.hs +15/−2
• src/Hoogle/Language/Haskell.hs +6/−4
• src/Hoogle/Query/Parser.hs +1/−1
• src/Recipe/Download.hs +2/−18
• src/Recipe/General.hs +12/−3
• src/Recipe/Hackage.hs +19/−21
• src/Recipe/Keyword.hs +2/−3
• src/Recipe/Type.hs +4/−6
• src/Web/All.hs +1/−2
• src/Web/Page.hs +4/−4
• src/Web/Response.hs +37/−36
• src/Web/Server.hs +1/−2

@@ -91,6 +91,10 @@     background-position: center right; } +#left .pad {+    padding-left: 16px;+}+ #left .minus {     color: #770E00;     padding-left: 16px;@@ -136,12 +140,10 @@ *  SPECIAL PAGES */ -#error {-    font-family: monospace;-}-#error u {-    border-bottom: 2px dotted red;+.error {+    border-bottom: 2px solid red;     text-decoration: none;+    white-space: pre; }  #example {

@@ -7,6 +7,7 @@  var currentSearch; // String var oldSearches = cache(100);+var timeoutId;  $(function(){     currentSearch = $("#hoogle").focus().keyup(searchBoxChange).val();@@ -24,14 +25,21 @@         bod.html(old);     else     {+        if (timeoutId != undefined) window.clearTimeout(timeoutId);+        timeoutId = window.setTimeout(function(){timeoutId = undefined; $("h1").text("Still working...");}, 500);         $.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);+                window.clearTimeout(timeoutId);+                timeoutId = undefined;+                if (e.status == 200) {+                    oldSearches.add(s,e.responseText);+                    if (txt.val() == s)+                        bod.html(e.responseText);+                } else+                    bod.html("<h1><b>Error:</b> status " + e.status + "</h1><p>" + e.responseText + "</p>");             }}(now)         });     }

@@ -1,7 +1,7 @@ cabal-version:      >= 1.6 build-type:         Simple name:               hoogle-version:            4.1.4+version:            4.1.5 license:            GPL license-file:       docs/LICENSE category:           Development

@@ -92,8 +92,9 @@   cmdLineWeb :: [(String,String)] -> IO CmdLine-cmdLineWeb args = cmdLineExpand $ blankSearch{web=True,-        start=askInt ["start"], count=askInt ["count"], webmode=ask ["mode"],-        queryChunks = maybeToList $ ask ["q","hoogle"]}+cmdLineWeb args = cmdLineExpand $ blankSearch+        {web=Just $ fromMaybe "web" $ ask ["mode"]+        ,start=askInt ["start"], count=askInt ["count"]+        ,queryChunks = maybeToList $ ask ["q","hoogle"]}     where ask x = listToMaybe [b | (a,b) <- args, a `elem` x]           askInt x = readMay =<< ask x

@@ -11,74 +11,72 @@ import Hoogle  -isWebCmdLine Search{web=True} = True+isWebCmdLine Search{web=Just _} = True isWebCmdLine Server{} = True isWebCmdLine _ = False   data CmdLine     = Search-        {web :: Bool                        -- ^ Are you operating from the web (via CGI)+        {color :: Bool+        ,link :: Bool+        ,info :: Bool+        ,databases :: [FilePath]         ,start :: Maybe Int         ,count :: Maybe Int-        ,webmode :: Maybe String-        ,info :: Bool-        ,link :: Bool-        ,color :: Bool+        ,web :: Maybe String         ,repeat_ :: Int-        ,databases :: [FilePath]         ,queryChunks :: [String]                  ,queryParsed :: Either ParseError Query         ,queryText :: String         }+    | Data {redownload :: Bool, local :: [String], datadir :: FilePath, threads :: Int, actions :: [String]}+    | Server {port :: Int, local_ :: Bool, databases :: [FilePath], resources :: FilePath, nostdin :: Bool}+    | Combine {srcfiles :: [FilePath], outfile :: String}+    | Convert {srcfile :: String, outfile :: String}     | Test {testFiles :: [String], example :: Bool}-    | Server {port :: Int, databases :: [FilePath], resources :: FilePath, local_ :: Bool, nostdin :: Bool}     | Dump {database :: String, section :: [String]}     | Rank {srcfile :: FilePath}-    | Combine {srcfiles :: [FilePath], outfile :: String}-    | Convert {srcfile :: String, outfile :: String}-    | Data {datadir :: FilePath, threads :: Int, haddock :: Bool, redownload :: Bool, actions :: [String], local :: [String]}       deriving (Data,Typeable,Show)  emptyParseError = ParseError 0 0 "" $ Str ""-blankSearch = Search False Nothing Nothing Nothing False False False 1 [] [] (Left emptyParseError) ""+blankSearch = Search False False False [] Nothing Nothing Nothing 1 [] (Left emptyParseError) "" -cmdLineMode = cmdArgsMode $ modes [search_ &= auto,test,server,dump,rank,combine,convert,dataa]+cmdLineMode = cmdArgsMode $ modes [search_ &= auto,dataa,server,combine,convert,test,dump,rank]     &= verbosity &= program "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"-    ,start = def-    ,count = def &= name "n" &= help "Return the first N results"-    ,webmode = def-    ,queryChunks = def &= args-    ,info = def-    ,link = def-    ,color = def-    ,databases = ["."] &= typDir &= help "Which directories to find databases"-    ,repeat_ = 1+    {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"+    ,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 over a list of files"+    } &= help "Run tests"  server = Server     {port = 80 &= typ "INT" &= help "Port number"-    ,resources = ""+    ,resources = "" &= typDir &= help "Directory to use for resources (images, CSS etc)"     ,nostdin = def &= help "Don't read from stdin"-    ,local_ = def &= help "Rewrite file:/// links and serve them, can be a security hole"+    ,local_ = def &= help "Rewrite and serve file: links (potential security hole)"     } &= help "Start a Hoogle server"  dump = Dump     {database = def &= argPos 0 &= typ "DATABASE"     ,section = def &= args &= typ "SECTION"-    } &= help "Dump sections of the database to stdout"+    } &= help "Dump sections of a database to stdout"  rank = Rank     {srcfile = def &= argPos 0 &= typ "RANKFILE" &= opt ""@@ -87,20 +85,19 @@ combine = Combine     {srcfiles = def &= args &= typ "DATABASE"     ,outfile = "default.hoo" &= typFile &= help "Output file (defaults to default.hoo)"-    } &= help "Combine multiple inputs to produce one output"+    } &= help "Combine multiple databases into one"  convert = Convert-    {srcfile = def &= argPos 0 &= typ "TEXTBASE"+    {srcfile = def &= argPos 0 &= typ "INPUT"     ,outfile = def &= argPos 1 &= typ "DATABASE" &= opt ""-    } &= help "Convert a textbase to a database"+    } &= help "Convert an input file to a database"  dataa = Data     {datadir = def &= typDir &= help "Database directory"-    ,haddock = def &= help "Get haddock documentation directly from Hackage"-    ,redownload = def &= help "Always redownload files from the web"-    ,threads = def &= typ "INT" &= name "j" &= help "Number of threads to use"+    ,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     ,actions = def &= args &= typ "RULE"-    ,local = def &= opt "" &= typ "FILEPATH" &= help "Use local documentation where found"+    ,local = def &= opt "" &= typ "FILEPATH" &= help "Use local documentation if available"     } &= 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:"

@@ -35,6 +35,7 @@  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     putStrLn $ "Converting " ++ from     src <- readFileUtf8 from     let (err,db) = createDatabase Haskell [] src

@@ -20,7 +20,7 @@     where         items = createItems xs         ys = entriesItems items-        ns = createSubstrSearch [(entryKey $ fromLink y, y) | y <- ys]+        ns = createSubstrSearch [(k, y) | y <- ys, let k = entryKey $ fromLink y, k /= ""]         as = createAliases (map aliases deps) facts         is = createInstances (map instances deps) facts         tys = [(sig, x) | x <- ys, Just sig <- [entryType $ fromLink x]]@@ -28,6 +28,7 @@   combineDataBase :: [DataBase] -> DataBase+combineDataBase [db] = db combineDataBase dbs = DataBase items_         ns (createTypeSearch as is tys)         ss as is

@@ -13,6 +13,7 @@ import qualified Data.Binary as Bin import qualified Data.Binary.Get as Bin import qualified Data.Binary.Put as Bin+import qualified Data.Set as Set import General.Base import Hoogle.Type.All import Hoogle.Score.All@@ -61,7 +62,7 @@     }  -searchSubstrSearch :: Eq a => SubstrSearch a -> String -> [(a, EntryView, Score)]+searchSubstrSearch :: SubstrSearch a -> String -> [(a, EntryView, Score)] searchSubstrSearch x y = reverse (sPrefix sN) ++ reverse (sInfix sN)     where         view = FocusOn y@@ -79,8 +80,20 @@         addMatch t s = s{sPrefix=(inds x $ sCount s,view,textScore t):sPrefix s}  +data S2 = S2+    {_s2Focus :: !BS.ByteString -- where we are in the string+    ,s2Result :: Set.Set BS.ByteString+    }+ completionsSubstrSearch :: SubstrSearch a -> String -> [String]-completionsSubstrSearch _ _ = []+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 = BSC.pack $ 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.unsafeTake i foc+                  i = fromIntegral ii   instance Show a => Show (SubstrSearch a) where

@@ -35,7 +35,7 @@ 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-        "keyword" -> Right $ itemKeyword $ dropWhile isSpace b+        "entry" -> Right $ itemEntry $ dropWhile isSpace b         "package" -> Right $ itemPackage $ dropWhile isSpace b         _ -> Left $ parseErrorWith line 2 ("Unknown attribute: " ++ a) $ '@':str     where (a,b) = break isSpace str@@ -76,12 +76,14 @@  fact x y = (x,[y]) -itemPackage x = fact [] $ textItem{itemLevel=0, itemKey=x, itemName=x,+itemPackage x = fact [] $ textItem{itemLevel=0, itemKey="", itemName=x,     itemURL="http://hackage.haskell.org/package/" ++ x ++ "/",     itemDisp=Tags [emph "package",space,bold x]} -itemKeyword x = fact [] $ textItem{itemName=x, itemKey=x,-    itemDisp=Tags [emph "keyword",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  itemModule xs = fact [] $ textItem{itemLevel=1, itemKey=last xs, itemName=intercalate "." xs,     itemURL="",

@@ -201,7 +201,7 @@ 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 (length xs)+    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)]

@@ -12,9 +12,9 @@     createDirectoryIfMissing True "download"     wget opt keywords "http://haskell.org/haskellwiki/Keywords"     wget opt platform "http://code.haskell.org/haskell-platform/haskell-platform.cabal"+    wget opt inputBase "http://haskell.org/hoogle/base.txt"     downloadTarball opt cabals "http://hackage.haskell.org/packages/archive/00-index.tar.gz"-    if haddock opt then downloadHaddocks opt-                   else downloadTarball opt haddocks "http://haskell.org/hoogle/hackage-haddock.tar.gz"+    downloadTarball opt inputs "http://hackage.haskell.org/packages/archive/00-hoogle.tar.gz"   wgetMay :: CmdLine -> FilePath -> URL -> IO Bool@@ -42,19 +42,3 @@         withDirectory out $             system_ $ "tar -xzf .." </> takeFileName out <.> "tar.gz"         writeFile (out <.> "txt") ""---downloadHaddocks :: CmdLine -> IO ()-downloadHaddocks opt = do-    b <- doesFileExist $ haddocks <.> "txt"-    unless b $ do-        xs <- listing cabals-        forM_ xs $ \name -> do-            ver <- version cabals name-            let out = haddocks </> name </> ver </> name <.> "txt"-                url = "http://hackage.haskell.org/packages/archive/" ++ name ++ "/" ++ ver ++ "/doc/html/" ++ name ++ ".txt"-            createDirectoryIfMissing True $ takeDirectory out-            b <- wgetMay opt out url-            unless b $ writeFile out ""-        withDirectory haddocks $ system_ "tar -czf../hackage-haddock.tar.gz *"-        writeFile (haddocks <.> "txt") ""

@@ -1,5 +1,5 @@ -module Recipe.General(convert, combine) where+module Recipe.General(convertSrc, convert, combine) where  import Recipe.Type import Hoogle@@ -7,11 +7,20 @@ import General.System import System.Console.CmdArgs.Verbosity +txt x = map toLower x <.> "txt"+hoo x = map toLower x <.> "hoo" ++convertSrc :: ([Name] -> IO ()) -> Name -> String -> IO ()+convertSrc make x src = do+    writeFileUtf8 (txt x) src+    convert make x++ -- convert a single database convert :: ([Name] -> IO ()) -> Name -> IO () convert make x = do-    b <- doesFileExist $ x <.> "txt"+    b <- doesFileExist $ txt x     if not b then         putWarning $ "Warning: " ++ x ++ " couldn't be converted, no input file found"      else do@@ -32,7 +41,7 @@  readInput :: Name -> IO ([Name], String) readInput x = do-    src <- readFileUtf8 $ x <.> "txt"+    src <- readFileUtf8 $ txt x     let (a,b) = span ("@depends " `isPrefixOf`) $ lines src     return (map (drop 9) a, unlines b) 

@@ -8,6 +8,7 @@ import General.System import General.Util import General.Web+import Control.Exception   -- FIXME: This is a list of hack@@ -25,7 +26,7 @@  makeAll :: ([Name] -> IO ()) -> IO () makeAll make = do-    xs <- listing haddocks+    xs <- listing inputs     make xs  @@ -38,36 +39,33 @@         let file = cabals </> name </> ver </> name <.> "cabal"         src <- readCabal file         return $ [""] ++ zipWith (++) ("-- | " : repeat "--   ") (cabalDescription src) ++-                 ["--","-- Version " ++ ver, "@package " ++ name]-    writeFile "package.txt" $ safeEncoding $ unlines $ concat xs-    convert noDeps "package"+                 ["--","-- Version " ++ ver, "@url package/" ++ name, "@entry package " ++ name]+    convertSrc noDeps "package" $ unlines $+        "@url http://hackage.haskell.org/" : "@package package" : concat xs   makeDefault :: ([Name] -> IO ()) -> [FilePath] -> Name -> IO () makeDefault make local name = do+    let base = name == "base"     b1 <- doesDirectoryExist $ cabals </> name-    b2 <- doesDirectoryExist $ haddocks </> name-    if not b1 || not b2 then+    b2 <- doesDirectoryExist $ inputs </> name+    if not base && (not b1 || not b2) then         putWarning $ "Warning: " ++ name ++ " couldn't find both Cabal and Haddock inputs"      else do         vc <- version cabals name-        vh <- version haddocks name+        vh <- if base then return vc else version inputs name         when (vc /= vh) $ putStrLn $ "Warning: Version mismatch for " ++ name ++ " (cabal=" ++ vc ++ ", haddock=" ++ vh ++ ")"-        let had = haddocks </> name </> vh </> name <.> "txt"+        let had = if base then inputBase else inputs </> name </> vh </> "doc" </> "html" </> name <.> "txt"             cab = cabals </> name </> vc </> name <.> "cabal"-        h <- openFile had ReadMode-        sz <- hFileSize h-        hClose h-        if sz == 0 then-            putWarning $ "Warning: " ++ name ++ " has no haddock output"-         else do-            had <- readFileUtf8' had-            cab <- readCabal cab-            loc <- findLocal local name-            writeFileUtf8 (name <.> "txt") $ unlines $-                ["@depends " ++ a | a <- cabalDepends cab \\ (name:avoid)] ++-                (maybe id haddockPackageUrl loc) (haddockHacks $ lines had)-            convert make name+        had <- try $ readFileUtf8' had+        case had of+            Left e -> putWarning $ "Warning: Exception when reading haddock for " ++ name ++ ", " ++ show (e :: SomeException)+            Right had -> do+                cab <- readCabal cab+                loc <- findLocal local name+                convertSrc make name $ unlines $+                    ["@depends " ++ a | a <- cabalDepends cab \\ (name:avoid)] +++                    (maybe id haddockPackageUrl loc) (haddockHacks $ lines had)   -- try and find a local filepath

@@ -9,8 +9,7 @@  makeKeyword :: IO () makeKeyword = do-    writeFileUtf8 "keyword.txt" . translate =<< readFile' keywords-    convert noDeps "keyword"+    convertSrc noDeps "keyword" . translate =<< readFile' keywords   translate :: String -> String@@ -30,7 +29,7 @@     ]  -keywordFormat x = concat ["" : docs ++ ["@url #" ++ concatMap g n, "@keyword " ++ noUnderscore n] | n <- name]+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

@@ -1,7 +1,7 @@  module Recipe.Type(-    CmdLine(..), Name, hoo, noDeps, safeEncoding,-    keywords, platform, cabals, haddocks, listing, version,+    CmdLine(..), Name, noDeps, safeEncoding,+    keywords, platform, cabals, inputs, inputBase, listing, version,     resetWarnings, putWarning, recapWarnings,     outStr, outStrLn     ) where@@ -15,10 +15,7 @@  type Name = String -hoo :: Name -> FilePath-hoo x = x <.> "hoo" - noDeps :: [Name] -> IO () noDeps [] = return () noDeps xs = error "Internal error: package with no dependencies had dependencies"@@ -35,7 +32,8 @@ keywords = "download/keyword.txt" platform = "download/haskell-platform.cabal" cabals = "download/hackage-cabal"-haddocks = "download/hackage-haddock"+inputs = "download/hackage-hoogle"+inputBase = "download/base.txt" -- FIXME: Temporary, until base.txt ends up on Hackage  listing :: FilePath -> IO [Name] listing dir = do

@@ -11,7 +11,6 @@ action q@Server{} = server q  -- 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]

@@ -5,8 +5,8 @@ import General.Util  -searchLink :: Args -> String -> URL-searchLink extra x = "?" ++ concat [a ++ "=" ++% b ++ "&" | (a,b) <- extra, a /= "hoogle"] ++ "hoogle=" ++% x+searchLink :: String -> URL+searchLink x = "?hoogle=" ++% x   header resources query =@@ -56,7 +56,7 @@     ]  -welcome extra =+welcome =     ["<h1><b>Welcome to Hoogle</b></h1>"     ,"<p>"     ,"  Hoogle is a Haskell API search engine, which allows you to search many standard Haskell libraries"@@ -82,4 +82,4 @@     ,"</p>"     ]     where-        search x = "<a href='" ++ searchLink extra x ++ "'>" ++& x ++ "</a><br/>"+        search x = "<a href='" ++ searchLink x ++ "'>" ++& x ++ "</a><br/>"

@@ -13,14 +13,13 @@ import Data.Time.Clock import Data.Time.Calendar import Network.HTTP-import Paths_hoogle   logFile = "log.txt" --- 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++response :: FilePath -> CmdLine -> IO (Response String)+response resources q = do     logMessage q     let response x = responseOk [Header HdrContentType x] @@ -28,17 +27,17 @@             dbs <- if isRight $ queryParsed q                    then fmap snd $ loadQueryDatabases (databases q) (fromRight $ queryParsed q)                    else return mempty-            return $ runQuery extra ajax dbs q+            return $ runQuery ajax dbs q -    case webmode q of+    case web q of         Just "ajax" -> do             res <- res True             return $ response "text/html" $ unlines res-        Nothing -> do+        Just "web" -> do             res <- res False             return $ response "text/html" $ unlines $ header resources (escapeHTML $ queryText q) ++ res ++ footer         Just "suggest" -> fmap (response "application/json") $ runSuggest q-        Just e -> return $ response "text/html" $ "Unknown webmode: " ++ show e+        Just e -> return $ response "text/html" $ "Unknown webmode: " ++ e   logMessage :: CmdLine -> IO ()@@ -52,39 +51,36 @@   runSuggest :: CmdLine -> IO String-runSuggest Search{queryText=q} = do-    root <- getDataDir-    db <- loadDatabase $ root </> "default.hoo"+runSuggest cq@Search{queryText=q} = do+    (_, db) <- loadQueryDatabases (databases cq) (Query [] Nothing [])     let res = queryCompletions db q     return $ "[" ++ show q ++ "," ++ show res ++ "]" runSuggest _ = return ""  -runQuery :: Args -> Bool -> Database -> CmdLine -> [String]-runQuery extra ajax dbs Search{queryParsed = Left err} =-    ["<h1><b>Parse error in user query</b></h1>"+runQuery :: Bool -> Database -> CmdLine -> [String]+runQuery ajax dbs Search{queryParsed = Left err} =+    ["<h1>" ++ showTagHTMLWith f (parseInput err) ++ "</h1>"     ,"<p>"-    ,"  Query: <span id='error'>" ++ showTagHTMLWith f (parseInput err) ++ "</span>"-    ,"</p><p>"-    ,"  Error: " ++& errorMessage err+    ,"  <b>Parse error:</b> " ++& errorMessage err     ,"</p><p>"     ,"  For information on what queries should look like, see the"     ,"  <a href='http://www.haskell.org/haskellwiki/Hoogle'>user manual</a>."     ,"</p>"     ]     where-        f (TagEmph x) = Just $ "<u>" ++ showTagHTMLWith f x ++ "</u>"+        f (TagEmph x) = Just $ "<span class='error'>" ++ showTagHTMLWith f x ++ "</span>"         f _ = Nothing  -runQuery extra ajax dbs q | isBlankQuery $ fromRight $ queryParsed q = welcome extra+runQuery ajax dbs q | isBlankQuery $ fromRight $ queryParsed q = welcome  -runQuery extra ajax dbs cq@Search{queryParsed = Right q, queryText = qt} =+runQuery ajax dbs cq@Search{queryParsed = Right q, queryText = qt} =     (if prefix then         ["<h1>" ++ qstr ++ "</h1>"] ++         ["<div id='left'>" ++ also ++ "</div>" | not $ null pkgs] ++-        ["<p>" ++ showTag extra sug ++ "</p>" | Just sug <- [querySuggestions dbs q]] +++        ["<p>" ++ showTag sug ++ "</p>" | Just sug <- [querySuggestions dbs q]] ++         if null res then             ["<p>No results found</p>"]         else@@ -98,25 +94,30 @@         count2 = maybe 20 (max 1) $ count cq          src = search dbs q-        res = [renderRes extra i (i /= 0 && i == start2 && prefix) x | (i,(_,x)) <- zip [0..] src]+        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 = "<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>"+        also = "<ul><li><b>Packages</b></li>" ++ concatMap f (take (5 + length minus) $ nub $ minus ++ pkgs) ++ "</ul>"+            where minus = [x | MinusPackage x <- scope q]+        f x | PlusPackage lx `elem` scope q =+                let q2 = showTagText $ renderQuery $ q{scope = filter (/= PlusPackage lx) $ scope q} in+                "<li><a class='minus' href='" ++ searchLink q2 ++ "'>" ++ x ++ "</a></li>"+            | MinusPackage lx `elem` scope q =+                let q2 = showTagText $ renderQuery $ q{scope = filter (/= MinusPackage lx) $ scope q} in+                "<li><a class='plus pad' href='" ++ searchLink 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]+                "<li><a class='minus' href='" ++ searchLink (qt ++ " -" ++ lx) ++ "'></a>" +++                "<a class='plus' href='" ++ searchLink (qt ++ " +" ++ lx) ++ "'>" ++ x ++ "</a></li>"+            where lx = map toLower x+        pkgs = [x | (_, (_,x):_)  <- concatMap (locations . snd) $ take (start2+count2) src] -        urlMore = searchLink extra qt ++ "&start=" ++ show (start2+count2+1) ++ "#more"+        urlMore = searchLink qt ++ "&start=" ++ show (start2+count2+1) ++ "#more"         qstr = showTagHTML (renderQuery q)  -renderRes :: Args -> Int -> Bool -> Result -> [String]-renderRes extra i more Result{..} =+renderRes :: Int -> Bool -> Result -> [String]+renderRes 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] ++@@ -128,7 +129,7 @@          docs2 = ("<div id='d" ++ show i ++ "' class='shut'>" ++                    "<a class='docs' onclick='return docs(" ++ show i ++ ")' href='" ++& selfUrl ++ "'></a>") ++?-                   showTag extra docs ++?+                   showTag docs ++?                "</div>"          url (TagBold x)@@ -143,9 +144,9 @@         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+showTag :: TagStr -> String+showTag = showTagHTML . transform f     where-        f (TagLink "" x) = TagLink (if "http:" `isPrefixOf` str then str else searchLink extra str) x+        f (TagLink "" x) = TagLink (if "http:" `isPrefixOf` str then str else searchLink str) x             where str = showTagText x         f x = x

@@ -3,7 +3,6 @@ module Web.Server(server) where  import General.Base-import General.Util import General.Web import CmdLine.All import Web.Response@@ -64,7 +63,7 @@     | path `elem` ["/","/hoogle"] = do         let args = parseHttpQueryArgs $ drop 1 query         cmd <- cmdLineWeb args-        r <- response "/res" (reps ("mode","ajax") ("ajax","1") args) cmd{databases=databases}+        r <- response "/res" 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