[Fix Web to use the new Hoogle interface, add suggest support
Neil Mitchell <http://www.cs.york.ac.uk/~ndm/>**20051114154020] {
hunk ./src/Web/Main.hs 17
-import Hoogle.Match
+import Hoogle.Hoogle
hunk ./src/Web/Main.hs 19
-import Hoogle.TypeSig
hunk ./src/Web/Main.hs 40
-main = do x <- if debugOut then fakeArgs else cgiArgs
+main = do args <- if debugOut then fakeArgs else cgiArgs
hunk ./src/Web/Main.hs 42
-          appendFile "log.txt" (show x ++ "\n")
-          let args = lookupDef "" "q" x
-          if null args then hoogleBlank else hoogle args x
+          appendFile "log.txt" (show args ++ "\n")
+          let input = lookupDef "" "q" args
+          if null input then hoogleBlank
+           else case hoogleParse input of
+                    Right x -> showError input x
+                    Left x -> showResults x args
hunk ./src/Web/Main.hs 83
--- | Perform a search, dump the results using 'putLine'
-hoogle :: String -> [(String, String)] -> IO ()
-hoogle args other =
+showError :: String -> String -> IO ()
+showError input err =
hunk ./src/Web/Main.hs 86
-    
hunk ./src/Web/Main.hs 87
-        outputFileParam "prefix" args
-        raw <- matchOrdered "res/hoogle.txt" args
-        let (err, res) = case raw of
-                              Left x -> ("error: " ++ err, [])
-                              Right x -> ("", x)
-            lres = length res
-            search = formatSearchString args
+        outputFileParam "prefix" input
+        outputFileParam "error" err
+        outputFileParam "suffix" input
+        
+
+
+-- | Perform a search, dump the results using 'putLine'
+showResults :: Search -> [(String, String)] -> IO ()
+showResults input args =
+    do
+        res <- hoogleResults "res/hoogle.txt" input
+        let lres = length res
+            search = hoogleSearch input
+            tSearch = showText search
hunk ./src/Web/Main.hs 103
+        debugInit
+        outputFileParam "prefix" tSearch
+
hunk ./src/Web/Main.hs 111
+        
+        case hoogleSuggest True input of
+            Nothing -> return ()
+            Just x -> putLine $ "<p id='suggest'>" ++ showTags x ++ "</p>"
hunk ./src/Web/Main.hs 116
-        if not (null err) then outputFileParam "error" args
-            else if null res then outputFileParam "noresults" args
-            else putLine $ "<table id='results'>" ++ concatMap showResult useres ++ "</table>"
+        if null res then outputFileParam "noresults" tSearch
+         else putLine $ "<table id='results'>" ++ concatMap showResult useres ++ "</table>"
hunk ./src/Web/Main.hs 123
-        outputFileParam "suffix" args
+        outputFileParam "suffix" tSearch
hunk ./src/Web/Main.hs 125
-        start = lookupDefInt 0 "start" other
-        num   = lookupDefInt 25 "num"  other
-        format = lookupDef "" "format" other
-        nostart = filter ((/=) "start" . fst) other
+        start = lookupDefInt 0 "start" args
+        num   = lookupDefInt 25 "num"  args
+        format = lookupDef "" "format" args
+        nostart = filter ((/=) "start" . fst) args
hunk ./src/Web/Main.hs 165
-showTags :: TagString -> String
+showTags :: TagStr -> String
hunk ./src/Web/Main.hs 167
-showTags (Tag 0 x) = "<b>" ++ showTags x ++ "</b>"
-showTags (Tag n x) = "<span class='c" ++ show n ++ "'>" ++ showTags x ++ "</span>"
+showTags (Tag "b" x) = "<b>" ++ showTags x ++ "</b>"
+showTags (Tag "u" x) = "<i>" ++ showTags x ++ "</i>"
+showTags (Tag "a" x) = "<a href='?q=" ++ escape (showText x) ++ "'>" ++ showTags x ++ "</a>"
+showTags (Tag [n] x) | n >= '1' && n <= '6' = 
+    "<span class='c" ++ n : "'>" ++ showTags x ++ "</span>"
+showTags (Tag n x) = showTags x
hunk ./src/Web/Main.hs 176
-showTagsLimit :: Int -> TagString -> String
-showTagsLimit n x = if left < 0 then res ++ ".." else res
+showTagsLimit :: Int -> TagStr -> String
+showTagsLimit n x = if length s > n then take (n-2) s ++ ".." else s
hunk ./src/Web/Main.hs 179
-        (left, res) = f n x
-        
-        f n (Str x) = if lx > n then (-1, take n x) else (n - lx, x)
-            where lx = length x
-        
-        f n (Tag 0 x) = (left, "<b>" ++ res ++ "</b>")
-            where (left, res) = f n x
-        f n (Tag c x) = (left, "<span class='c" ++ show c ++ "'>" ++ res ++ "</span>")
-        
-        f n (Tags []) = (n, "")
-        f n (Tags (x:xs)) = if left == -1 then (left, res) else (left2, res ++ res2)
-            where
-                (left, res) = f n x
-                (left2, res2) = f left (Tags xs)
-        
+        s = showText x
hunk ./src/Web/Main.hs 197
-hoodoc :: TagString -> Maybe TagString -> String
+hoodoc :: TagStr -> Maybe TagStr -> String
}