" + e.responseText + "
"); }}(now) }); } diff --git a/hoogle.cabal b/hoogle.cabal --- a/hoogle.cabal +++ b/hoogle.cabal @@ -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 diff --git a/src/CmdLine/All.hs b/src/CmdLine/All.hs --- a/src/CmdLine/All.hs +++ b/src/CmdLine/All.hs @@ -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 diff --git a/src/CmdLine/Type.hs b/src/CmdLine/Type.hs --- a/src/CmdLine/Type.hs +++ b/src/CmdLine/Type.hs @@ -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:" diff --git a/src/Console/All.hs b/src/Console/All.hs --- a/src/Console/All.hs +++ b/src/Console/All.hs @@ -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 diff --git a/src/Hoogle/DataBase/All.hs b/src/Hoogle/DataBase/All.hs --- a/src/Hoogle/DataBase/All.hs +++ b/src/Hoogle/DataBase/All.hs @@ -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 diff --git a/src/Hoogle/DataBase/SubstrSearch.hs b/src/Hoogle/DataBase/SubstrSearch.hs --- a/src/Hoogle/DataBase/SubstrSearch.hs +++ b/src/Hoogle/DataBase/SubstrSearch.hs @@ -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 diff --git a/src/Hoogle/Language/Haskell.hs b/src/Hoogle/Language/Haskell.hs --- a/src/Hoogle/Language/Haskell.hs +++ b/src/Hoogle/Language/Haskell.hs @@ -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="", diff --git a/src/Hoogle/Query/Parser.hs b/src/Hoogle/Query/Parser.hs --- a/src/Hoogle/Query/Parser.hs +++ b/src/Hoogle/Query/Parser.hs @@ -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)] diff --git a/src/Recipe/Download.hs b/src/Recipe/Download.hs --- a/src/Recipe/Download.hs +++ b/src/Recipe/Download.hs @@ -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") "" diff --git a/src/Recipe/General.hs b/src/Recipe/General.hs --- a/src/Recipe/General.hs +++ b/src/Recipe/General.hs @@ -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) diff --git a/src/Recipe/Hackage.hs b/src/Recipe/Hackage.hs --- a/src/Recipe/Hackage.hs +++ b/src/Recipe/Hackage.hs @@ -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 diff --git a/src/Recipe/Keyword.hs b/src/Recipe/Keyword.hs --- a/src/Recipe/Keyword.hs +++ b/src/Recipe/Keyword.hs @@ -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 diff --git a/src/Recipe/Type.hs b/src/Recipe/Type.hs --- a/src/Recipe/Type.hs +++ b/src/Recipe/Type.hs @@ -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 diff --git a/src/Web/All.hs b/src/Web/All.hs --- a/src/Web/All.hs +++ b/src/Web/All.hs @@ -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] diff --git a/src/Web/Page.hs b/src/Web/Page.hs --- a/src/Web/Page.hs +++ b/src/Web/Page.hs @@ -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 = ["" ," Hoogle is a Haskell API search engine, which allows you to search many standard Haskell libraries" @@ -82,4 +82,4 @@ ,"
" ] where - search x = "" ++& x ++ "" - ," Query: " ++ showTagHTMLWith f (parseInput err) ++ "" - ,"
" - ," Error: " ++& errorMessage err + ," Parse error: " ++& errorMessage err ,"
" ," For information on what queries should look like, see the" ," user manual." ,"
" ] where - f (TagEmph x) = Just $ "" ++ showTagHTMLWith f x ++ "" + f (TagEmph x) = Just $ "" ++ showTagHTMLWith f x ++ "" 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 ["" ++ showTag extra sug ++ "
" | Just sug <- [querySuggestions dbs q]] ++ + ["" ++ showTag sug ++ "
" | Just sug <- [querySuggestions dbs q]] ++ if null res then ["No results found
"] 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 = "