hoogle 4.0.0.5 → 4.0.6

raw patch · 47 files changed

+86/−62 lines, 47 filesdep ~basebinary-added

Dependency ranges changed: base

Files

• database/array.hoo binary
• database/base.hoo binary
• database/bytestring.hoo binary
• database/cabal.hoo binary
• database/containers.hoo binary
• database/default.hoo too large to diff
• database/directory.hoo binary
• database/filepath.hoo binary
• database/ghc.hoo binary
• database/hackage.hoo binary
• database/haskell-src.hoo binary
• database/hunit.hoo binary
• database/keyword.hoo binary
• database/mtl.hoo binary
• database/parallel.hoo binary
• database/parsec.hoo binary
• database/pretty.hoo binary
• database/process.hoo binary
• database/random.hoo binary
• database/stm.hoo binary
• database/syb.hoo binary
• database/template-haskell.hoo binary
• database/time.hoo binary
• database/xhtml.hoo binary
• hoogle.cabal +4/−3
• src/CmdLine/Action.hs +4/−4
• src/CmdLine/Flag.hs +13/−6
• src/CmdLine/Query.hs +2/−0
• src/Data/Binary/Defer/Class.hs +1/−1
• src/Data/Binary/Defer/Map.hs +2/−2
• src/Data/Binary/Defer/Monad.hs +1/−1
• src/Data/TagStr.hs +1/−1
• src/General/CGI.hs +11/−2
• src/General/Util.hs +1/−1
• src/Hoogle/DataBase/Aliases.hs +1/−1
• src/Hoogle/DataBase/Suggest.hs +3/−3
• src/Hoogle/Item/URL.hs +1/−2
• src/Hoogle/Operations/RankSolve.hs +2/−2
• src/Hoogle/Query/Parser.hs +10/−8
• src/Hoogle/Query/Suggest.hs +1/−1
• src/Hoogle/TextBase/Parser.hs +1/−1
• src/Hoogle/TypeSig/Parser.hs +3/−3
• src/Hoogle/TypeSig/Type.hs +1/−1
• src/Test/Parse_Query.hs +2/−0
• src/Test/Parse_TypeSig.hs +4/−0
• src/Web/Action.hs +8/−12
• src/Web/Page.hs +9/−7

binary file changed (83122 → 55340 bytes)

binary file changed (590378 → 601365 bytes)

binary file changed (183341 → 178686 bytes)

binary file changed (376830 → 418169 bytes)

binary file changed (143415 → 171856 bytes)

file too large to diff

binary file changed (51298 → 47172 bytes)

binary file changed (67927 → 66087 bytes)

binary file changed (312693 → 75900 bytes)

binary file changed (323754 → 573525 bytes)

binary file changed (109354 → 105102 bytes)

binary file changed (42432 → 37023 bytes)

binary file changed (19866 → 20307 bytes)

binary file changed (79491 → 74072 bytes)

binary file changed (48371 → 43831 bytes)

binary file changed (195681 → 190281 bytes)

binary file changed (43710 → 38647 bytes)

binary file changed (41534 → 43356 bytes)

binary file changed (36518 → 31118 bytes)

binary file changed (39852 → 34850 bytes)

binary file changed (absent → 48720 bytes)

binary file changed (128618 → 130341 bytes)

binary file changed (73485 → 68144 bytes)

binary file changed (114776 → 110050 bytes)

@@ -1,7 +1,7 @@ cabal-version:      >= 1.2 build-type:         Simple name:               hoogle-version:            4.0.0.5+version:            4.0.6 license:            GPL license-file:       docs/LICENSE category:           Development@@ -39,6 +39,7 @@     quickcheck.hoo     random.hoo     stm.hoo+    syb.hoo     template-haskell.hoo     time.hoo     xhtml.hoo@@ -49,9 +50,9 @@ executable hoogle     build-depends: parsec, filepath, safe, uniplate, mtl, time     if flag(splitBase)-        build-depends: base >= 3, directory, process, containers, array, bytestring+        build-depends: base >= 3 && < 4, directory, process, containers, array, bytestring     else-        build-depends: base < 3+        build-depends: base >= 2 && < 3      main-is:            Main.hs     hs-source-dirs:     src

@@ -17,13 +17,13 @@  actionCmdLine :: CmdQuery -> IO () -actionCmdLine CmdQuery{queryText = text, query = Left err} = do+actionCmdLine CmdQuery{queryText = text, query = Left err} =     exitMessage ["Parse error:", "  " ++ text                 ,replicate (sourceColumn (errorPos err) + 1) ' ' ++ "^"                 ,show err]  -actionCmdLine q | not $ null $ queryBadFlags q = do+actionCmdLine q | not $ null $ queryBadFlags q =     exitMessage $ "Unrecognised or malformed flags:":                   map ("  "++) (queryBadFlags q) ++                   ["For details on correct flags pass --help"]@@ -52,7 +52,7 @@     mapM_ rank [x | Rank x <- queryFlags q]  -actionCmdLine q | Convert{} `elemEnum` queryFlags q = do+actionCmdLine q | Convert{} `elemEnum` queryFlags q =     mapM_ (actionConvert q) [x | Convert x <- queryFlags q]  @@ -73,7 +73,7 @@     mapM_ (actionDump q) dbs  -actionCmdLine q | not $ usefulQuery $ fromRight $ query q = do+actionCmdLine q | not $ usefulQuery $ fromRight $ query q =     exitMessage ["No query entered"                 ,"Try --help for command line options"] 

@@ -127,14 +127,11 @@   flagsHelp :: String-flagsHelp = unlines $ map f res+flagsHelp = unlines . map concat . tabulate $ map f res     where-        f (a,b,c) = "  " ++ (if null a then "    " else "--" ++ a ++ ",") ++-                    " --" ++ b ++ replicate (maxLong - length b) ' ' ++-                    "  " ++ c+        f (a,b,c) = ["  ", "--" <+ a, " --" ++ b, "  " ++ c] -        maxLong = maximum $ map (length . snd3) res-        res = [ (shortOpt (names i), longOpt (names i) ++ typ (argument i), description i)+        res = [ (shortOpt (names i) +> typ (argument i), longOpt (names i) ++ typ (argument i), description i)               | i <- flagInfo, PCmdLine `elem` permissions i]          shortOpt ([x]:_) = [x]@@ -145,6 +142,16 @@          typ x = ['='|s/=""] ++ s             where s = show x+        +        x +> y = if null x then "" else x ++ y+        x <+ y = if null y then "" else x ++ y+++tabulate :: [[String]]                -- rectangular matrix per lines+         -> [[String]]                -- nicely padded+tabulate = transpose . map sameLen . transpose+   where sameLen xs     = flushLeft ((maximum . map length) xs) xs+         flushLeft n xs = [ take n (x ++ repeat ' ') | x <- xs ]   ---------------------------------------------------------------------

@@ -55,6 +55,8 @@         str = unwords $ map snd q  +-- TODO: Checking for web and debug specifically are both hacks+--       Should parse any arguments it can separately cmdQueryArgs :: [String] -> IO CmdQuery cmdQueryArgs xs = case parseCmdLineQuery xs of     Left err -> return $ CmdQuery (hasFlag ["w","web"]) orig (Left err) [Debug | hasFlag ["debug"]] []

@@ -169,7 +169,7 @@      get = do         i <- getByte-        if i /= maxByte then do+        if i /= maxByte then             replicateM (fromIntegral i) get          else do             xs <- replicateM 100 get

@@ -17,5 +17,5 @@   instance (Ord k, BinaryDefer k, BinaryDefer v) => BinaryDefer (Data.Map.Map k v) where-    put = putDefer . put . Vector.fromList . Prelude.map (id *** Defer) . Data.Map.toAscList-    get = getDefer $ liftM (Data.Map.fromAscList . Prelude.map (id *** fromDefer) . Vector.toList) get+    put = putDefer . put . Vector.fromList . Prelude.map (second Defer) . Data.Map.toAscList+    get = getDefer $ liftM (Data.Map.fromAscList . Prelude.map (second fromDefer) . Vector.toList) get

@@ -83,7 +83,7 @@     lift $ do         p <- bufferPos buf         b <- bufferPatch buf pos (fromIntegral p :: Int32)-        when (not b) $ modifyIORef back (DeferPatchup pos p :)+        unless b $ modifyIORef back (DeferPatchup pos p :)     act     runDeferPendings 

@@ -45,5 +45,5 @@         getCode (TagColor n _) | n <= 5 && n >= 0 = Just ['3', intToDigit (n + 1)]         getCode _ = Nothing -        tag stack = chr 27 : '[' : (concat $ intersperse ";" $ ("0":reverse stack)) ++ "m"+        tag stack = chr 27 : '[' : (concat $ intersperse ";" $ "0":reverse stack) ++ "m" 

@@ -15,9 +15,18 @@ import Data.List  +-- The BOA server does not set QUERY_STRING if it would be blank.+-- However, it does always set REQUEST_URI. cgiVariable :: IO (Maybe String)-cgiVariable = catch (liftM Just $ getEnv "QUERY_STRING")-                    (const $ return Nothing)+cgiVariable = do+    str <- envVariable "QUERY_STRING"+    if isJust str+        then return str+        else liftM (liftM $ const "") $ envVariable "REQUEST_URI"+++envVariable :: String -> IO (Maybe String)+envVariable x = catch (liftM Just $ getEnv x) (const $ return Nothing)   cgiArgs :: IO (Maybe [(String, String)])

@@ -68,7 +68,7 @@ -- | all permutations of a list permute :: [a] -> [[a]] permute [] = [[]]-permute (x:xs) = concat $ map (\a -> zipWith f (inits a) (tails a)) (permute xs)+permute (x:xs) = concatMap (\a -> zipWith f (inits a) (tails a)) (permute xs)     where         f a b = a ++ [x] ++ b 

@@ -79,7 +79,7 @@   normAliases :: Aliases -> Type -> ([String], Type)-normAliases as t = (sort . nub *** id) $ f t+normAliases as t = first (sort . nub) $ f t     where         f t = case followAlias as t of                   Just (s,t) -> ([s],t)

@@ -88,7 +88,7 @@         (if null b1 && null b2 then a1 `mplus` a2 else Nothing)         (f b1 b2) (f c1 c2)     where-        f x y = map (id *** maximum) $ sortGroupFsts $ x ++ y+        f x y = map (second maximum) $ sortGroupFsts $ x ++ y   askSuggest :: [Suggest] -> TypeSig -> Maybe (Either String TypeSig)@@ -130,8 +130,8 @@  improve :: (String -> Maybe SuggestItem) -> Bool -> Type -> Type improve get cls typ-        | cls == False = f $ transform (improveName nameTyp) typ-        | cls == True  = improveArity arity $+        | not cls = f $ transform (improveName nameTyp) typ+        | otherwise = improveArity arity $             tApp (improveName nameCls t1) (map (transform (improveName nameTyp)) ts)     where         (t1,ts) = fromTApp typ

@@ -3,7 +3,6 @@  import General.Code import Hoogle.Item.Item-import Web.Text(escapeHTML) -- TODO: Shouldn't be importing this! import Numeric import Data.Binary.Defer.Index @@ -12,7 +11,7 @@ entryURL :: Entry -> String entryURL e@Entry{entryType=EntryModule} = entryModuleURL e entryURL e@Entry{entryType=EntryPackage} = entryPackageURL e-entryURL e@Entry{entryType=EntryOther} = entryModuleURL e ++ "#v:" ++ escapeHTML (entryName e)+entryURL e@Entry{entryType=EntryOther} = entryModuleURL e ++ "#v:" ++ entryName e entryURL e@Entry{entryType=EntryKeyword} =         "http://www.haskell.org/haskellwiki/Keywords#" ++ concatMap f (entryName e)     where

@@ -58,8 +58,8 @@     where         -- all x in xs, x.max = ys.max - 1         -- all y in ys, y.min = xs.min + 1-        f mp (xs :< ys) = upd (id *** min (maxRhs - 1)) xs $-                          upd (max (minLhs + 1) *** id) ys mp+        f mp (xs :< ys) = upd (second $ min (maxRhs - 1)) xs $+                          upd (first  $ max (minLhs + 1)) ys mp             where                 minLhs = grab fst xs mp                 maxRhs = grab snd ys mp

@@ -7,7 +7,7 @@ import Text.ParserCombinators.Parsec  -ascSymbols = "!#$%&*+./<=>?@\\^|-~"+ascSymbols = "!#$%&*+./<=>?@\\^|-~:"  parseQuery :: String -> Either ParseError Query parseQuery input = parse parsecQuery "" input@@ -43,7 +43,7 @@                  name = (do x <- operator ; spaces ; return blankQuery{names=[x]})                <|>-               (do xs <- keyword `sepBy1` (char '.') ; spaces+               (do xs <- keyword False `sepBy1` (char '.') ; spaces                    return $ case xs of                        [x] -> blankQuery{names=[x]}                        xs -> blankQuery{names=[last xs],scope=[PlusModule (init xs)]}@@ -51,7 +51,9 @@                  operator = between (char '(') (char ')') op <|> op -        op = many1 $ satisfy (`elem` ascSymbols)+        op = try $ do+            res <- many1 $ satisfy (`elem` ascSymbols)+            if res == "::" then fail ":: is not an operator name" else return res                  types = do a <- flags                    b <- parsecTypeSig@@ -92,11 +94,11 @@                        [x] -> return $ blankQuery{scope=[if isLower (head x) then aPackage x else aModule [x]]}                        xs -> return $ blankQuery{scope=[aModule xs]} -        modname = keyword `sepBy1` (char '.')+        modname = keyword True `sepBy1` (char '.')  --- TODO: Should share this definition with Hoogle.TypeSig.Parser-keyword = do x <- letter-             xs <- many $ satisfy (\x -> isAlphaNum x || x `elem` "_'#")-             return (x:xs)+keyword hyphen = do+    x <- letter+    xs <- many $ satisfy (\x -> isAlphaNum x || x `elem` "_'#" || (hyphen && x == '-'))+    return (x:xs) 

@@ -22,7 +22,7 @@ -- They searched for "Int to Float", they meant "Int -> Float" suggestQuery db q@Query{typeSig=Nothing, names=names} | "to" `elem` names = Just $ didYouMean q2     where q2 = fixup db $ q{names = [] ,typeSig = Just $ TypeSig [] t2}-          t2 = TFun $ map (toApp . map toLitVar) $ split "to" $ names+          t2 = TFun $ map (toApp . map toLitVar) $ split "to" names  -- They search for "Maybe a", did they mean ":: Maybe a" suggestQuery db q@Query{typeSig=Nothing, names=names} | length names > 1 && all f names = Just $ didYouMean q2

@@ -85,6 +85,6 @@         keysymbol = many1 $ satisfy (\x -> isSymbol x || x `elem` ascSymbol)         ascSymbol = "!#$%&*+./<=>?@\\^|-~:" -        keyword = do x <- letter+        keyword = do x <- satisfy (\x -> isAlphaNum x || x == '_')                      xs <- many $ satisfy (\x -> isAlphaNum x || x `elem` "_'#")                      return (x:xs)

@@ -51,7 +51,7 @@                        close                        return $ tLit hash (length xs + 1)                     ) <|>-                    (do sym <- white $ keysymbol+                    (do sym <- white keysymbol                         close                         return $ TLit sym                     ) <|>@@ -67,10 +67,10 @@                     where h = ['#'|hash]                          -        atom = do x <- satisfy isAlpha+        atom = do x <- satisfy (\x -> isAlpha x || x == '_')                   xs <- many $ satisfy (\x -> isAlphaNum x || x `elem` "_'#")                   whites-                  return $ (if isLower x then TVar else TLit) (x:xs)+                  return $ (if isLower x || x == '_' then TVar else TLit) (x:xs)          -- may be [a], or [] (then application takes the a after it)         list = do char '['

@@ -150,7 +150,7 @@             f i (TLit x) = x             f i (TVar x) = x             -            f i (TApp x xs) = b (i > 1) $ concat (intersperse " " $ map (f 2) (x:xs))+            f i (TApp x xs) = b (i > 1) $ unwords $ map (f 2) (x:xs)             f i (TFun xs)   = b (i > 0) $ concat (intersperse " -> " $ map (f 1) xs)                          b True x = "(" ++ x ++ ")"

@@ -28,9 +28,11 @@     "map :: a -> b" === q{names = ["map"], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))}     "+Data.Map map" === q{scope = [PlusModule ["Data","Map"]], names = ["map"]}     "a -> b +foo" === q{scope = [PlusPackage "foo"], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))}+    "a -> b +foo-bar" === q{scope = [PlusPackage "foo-bar"], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))}     "a -> b /foo" === q{flags = [Flag "foo" ""], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))}     "a -> b --foo" === q{flags = [Flag "foo" ""], typeSig = Just (TypeSig [] (TFun [TVar "a",TVar "b"]))}     "Data.Map.map" === q{scope = [PlusModule ["Data","Map"]], names = ["map"]}     "[a]" === q{typeSig = Just (TypeSig [] (TApp (TLit "[]") [TVar "a"]))}     "++" === q{names = ["++"]}     "(++)" === q{names = ["++"]}+    ":+:" === q{names = [":+:"]}

@@ -9,7 +9,11 @@      -- really basic stuff     "a" === TypeSig [] (TVar "a")+    "a_" === TypeSig [] (TVar "a_")+    "_" === TypeSig [] (TVar "_")+    "_a" === TypeSig [] (TVar "_a")     "A" === TypeSig [] (TLit "A")+    "A_" === TypeSig [] (TLit "A_")     "m a" === TypeSig [] (TApp (TVar "m") [TVar "a"])     "M a b" === TypeSig [] (TApp (TLit "M") [TVar "a",TVar "b"]) 

@@ -23,6 +23,9 @@ import Paths_hoogle  +logFile = "log.txt"++ actionWeb :: CmdQuery -> IO () actionWeb q = do     logMessage q@@ -33,25 +36,18 @@         else do             putStr "Content-type: text/html\n\n"             (skipped,dbs) <- loadDataBases q-            return $ unlines $ header (escapeHTML $ queryText $ queryPretty q) ++ runQuery dbs q ++ footer+            return $ unlines $ header (escapeHTML $ queryText q) ++ runQuery dbs q ++ footer     putStrLn res     when (Debug `elem` queryFlags q) $         writeFile "temp.htm" res     sequence_ [writeFile x res | Output x <- queryFlags q]  --- TODO: Hacky, requires a better parser--- Strip out Web, Debug and Output from queryText-queryPretty :: CmdQuery -> CmdQuery-queryPretty q = q{queryText = unwords $ filter f $ words $ queryText q}-    where f x = not $ any (`isPrefixOf` x) ["/debug","/output","/web"]-- logMessage :: CmdQuery -> IO () logMessage q = do     time <- getCurrentTime-    cgi <- liftM (fromMaybe []) $ cgiArgs-    appendFile "log.txt" $ (++ "\n") $ unwords $+    cgi <- liftM (fromMaybe []) cgiArgs+    appendFile logFile $ (++ "\n") $ unwords $         [showGregorian (utctDay time)         ,show (queryText q)] ++         ["?" ++ a ++ "=" ++ c ++ b ++ c | (a,b) <- cgi, let c = ['\"' | any isSpace b]]@@ -159,7 +155,7 @@         pkgname = td "pkg" $ href urlPkg $ packageName $ fromLink $ entryPackage ent          docs = ("<div id='d" ++ show i ++ "' class='shut'>" ++-                   "<a class='docs' onclick='return docs(" ++ show i ++ ")' href='" ++ urlEnt ++ "'></a>") +?+                   "<a class='docs' onclick='return docs(" ++ show i ++ ")' href='" +& urlEnt ++ "'></a>") +?                    (showTagHTML $ renderHaddock $ entryDocs ent) +?                "</div>" @@ -175,4 +171,4 @@  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>"+href url x = if null url then x else "<a class='dull' href='" +& url ++ "'>" ++ x ++ "</a>"

@@ -3,16 +3,18 @@  import Web.Text +resourcePath = "res/"+ header 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'>"     ,"  <head profile='http://a9.com/-/spec/opensearch/1.1/'>"     ,"     <meta http-equiv='Content-Type' content='text/html; charset=iso-8859-1' />"     ,"     <title>" ++ (query +? " - ") ++ "Hoogle</title>"-    ,"     <link type='text/css' rel='stylesheet' href='res/hoogle.css' />"-    ,"     <link type='image/png' rel='icon' href='res/favicon.png' />"-    ,"     <link type='application/opensearchdescription+xml' rel='search' href='res/search.xml' title='Hoogle' />"-    ,"     <script type='text/javascript' src='res/hoogle.js'> </script>"+    ,"     <link type='text/css' rel='stylesheet' href='" ++ resourcePath ++ "hoogle.css' />"+    ,"     <link type='image/png' rel='icon' href='" ++ resourcePath ++ "favicon.png' />"+    ,"     <link type='application/opensearchdescription+xml' rel='search' href='" ++ resourcePath ++ "search.xml' title='Hoogle' />"+    ,"     <script type='text/javascript' src='" ++ resourcePath ++ "hoogle.js'> </script>"     ,"  </head>"     ,"  <body onload='on_load()'>"     ] ++ links ++ search query@@ -30,7 +32,7 @@     ["<form action='.' method='get'>"     ,"  <div id='search'>"     ,"    <a id='logo' href='http://haskell.org/hoogle/'>" ++-           "<img src='res/hoogle.png' alt='Hoogle' />" +++           "<img src='" ++ resourcePath ++ "hoogle.png' alt='Hoogle' />" ++          "</a>"     ,"    <input name='hoogle' id='hoogle' type='text' value=\"" ++ query ++ "\" />"     ,"    <input id='submit' type='submit' value='Search' />"@@ -40,7 +42,7 @@   footer =-    ["    <p id='footer'>&copy; <a href='http://www.cs.york.ac.uk/~ndm/'>Neil Mitchell</a> 2004-2008</p>"+    ["    <p id='footer'>&copy; <a href='http://community.haskell.org/~ndm/'>Neil Mitchell</a> 2004-2009</p>"     ,"  </body>"     ,"</html>"     ]@@ -67,7 +69,7 @@     ,"</p>"     ,"<p>"     ,"  I am very interested in any feedback you may have. Please "-    ,"  <a href='http://www-users.cs.york.ac.uk/~ndm/contact/'>email me</a>, or add an entry to my"+    ,"  <a href='http://community.haskell.org/~ndm/contact/'>email me</a>, or add an entry to my"     ,"  <a href='http://code.google.com/p/ndmitchell/issues/list'>bug tracker</a>."     ,"</p>"     ]