diff --git a/hoogle.cabal b/hoogle.cabal --- a/hoogle.cabal +++ b/hoogle.cabal @@ -1,7 +1,7 @@ cabal-version: >= 1.10 build-type: Simple name: hoogle -version: 4.2.22 +version: 4.2.23 license: BSD3 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 @@ -35,7 +35,7 @@ cmdLineExpand :: CmdLine -> IO CmdLine cmdLineExpand x@Search{} = do db <- expandDatabases $ databases x - return $ x { queryText = s + return x { queryText = s , queryParsed = (\q -> q { exactSearch = if exact x @@ -51,7 +51,7 @@ dat <- getDataDir db <- expandDatabases $ databases x let res = if null $ resources x then dat "resources" else resources x - return $ x{databases=db, resources=res} + return x{databases=db, resources=res} cmdLineExpand x@Test{} = do dat <- getDataDir @@ -68,6 +68,10 @@ let thrd = if threads x == 0 then numCapabilities else threads x loc <- if all null (local x) && not (null $ local x) then guessLocal else return $ local x return x{datadir=dir, threads=thrd, local=loc} + +cmdLineExpand x@Convert{} = + return x{haddock = haddock x || isJust (doc x), + outfile = if null (outfile x) then replaceExtension (srcfile x) "hoo" else outfile x} cmdLineExpand x = return x diff --git a/src/CmdLine/Type.hs b/src/CmdLine/Type.hs --- a/src/CmdLine/Type.hs +++ b/src/CmdLine/Type.hs @@ -35,7 +35,7 @@ | Data {redownload :: Bool, local :: [String], datadir :: FilePath, threads :: Int, actions :: [String]} | Server {port :: Int, local_ :: Bool, databases :: [FilePath], resources :: FilePath, dynamic :: Bool, template :: [FilePath]} | Combine {srcfiles :: [FilePath], outfile :: String} - | Convert {srcfile :: String, outfile :: String} + | Convert {srcfile :: String, outfile :: String, doc :: Maybe String, merge :: [String], haddock :: Bool} | Log {logfiles :: [FilePath]} | Test {testFiles :: [String], example :: Bool} | Dump {database :: String, section :: [String]} @@ -94,6 +94,9 @@ convert = Convert {srcfile = def &= argPos 0 &= typ "INPUT" ,outfile = def &= argPos 1 &= typ "DATABASE" &= opt "" + ,doc = def &= typDir &= help "Path to the root of local or Hackage documentation for the package (implies --haddock)" + ,merge = def &= typ "DATABASE" &= help "Merge other databases" + ,haddock = def &= help "Apply haddock-specific hacks" } &= help "Convert an input file to a database" data_ = Data @@ -106,7 +109,7 @@ &= details ["Each argument should be the name of a database you want to generate" ,"optionally followed by which files to combine. Common options:" ,"" - ," data default -- equialent to no arguments" + ," data default -- equivalent to no arguments" ," data all" ] diff --git a/src/Console/All.hs b/src/Console/All.hs --- a/src/Console/All.hs +++ b/src/Console/All.hs @@ -3,12 +3,15 @@ import CmdLine.All import Recipe.All +import Recipe.General +import Recipe.Haddock import Console.Log import Console.Search import Console.Test import Console.Rank import General.Base import General.System +import General.Web import Hoogle @@ -26,9 +29,10 @@ action (Test files _) = do testPrepare fails <- fmap sum $ mapM (testFile action) files - if fails == 0 - then putStrLn "Tests passed" - else putStrLn $ "TEST FAILURES (" ++ show fails ++ ")" + putStrLn $ + if fails == 0 + then "Tests passed" + else "TEST FAILURES (" ++ show fails ++ ")" action (Rank file) = rank file @@ -36,15 +40,25 @@ action (Log files) = logFiles files -action (Convert from to) = do - to <- return $ if null to then replaceExtension from "hoo" else to +action (Convert from to doc merge haddock) = do 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 - unless (null err) $ putStr $ unlines $ "Warning: parse errors" : map show err - saveDatabase to db - putStrLn $ "Written " ++ to + convert merge (takeBaseName from) to $ unlines $ addLocalDoc doc (lines src) + where + addLocalDoc :: Maybe FilePath -> [String] -> [String] + addLocalDoc doc = if haddock + then haddockHacks $ addDoc doc + else id + + addDoc :: Maybe FilePath -> Maybe URL + addDoc = addGhcDoc . fmap (\x -> if "http://" `isPrefixOf` x then x else filePathToURL $ x "index.html") + + addGhcDoc :: Maybe URL -> Maybe URL + addGhcDoc x = if isNothing x && takeBaseName from == "ghc" + then Just "http://www.haskell.org/ghc/docs/latest/html/libraries/ghc/" + else x + action (Combine from to) = do putStrLn $ "Combining " ++ show (length from) ++ " databases" diff --git a/src/Recipe/Download.hs b/src/Recipe/Download.hs --- a/src/Recipe/Download.hs +++ b/src/Recipe/Download.hs @@ -74,7 +74,7 @@ hasTar <- check "tar" when (any isNothing [hasGzip, hasTar]) $ error "Could not extract tarball(s), could not find either gzip or tar on the $PATH." putStrLn "Extracting tarball... " - system_ $ "gzip --decompress --force .." takeFileName out <.> "tar.gz" + system_ $ "gzip --decompress --stdout --force .." takeFileName out <.> "tar.gz > .." takeFileName out <.> "tar" system_ $ "tar -xf .." takeFileName out <.> "tar" putStrLn "Finished extracting tarball" writeFile (out <.> "txt") "" diff --git a/src/Recipe/General.hs b/src/Recipe/General.hs --- a/src/Recipe/General.hs +++ b/src/Recipe/General.hs @@ -11,40 +11,26 @@ hoo x = map toLower x <.> "hoo" -convertSrc :: ([Name] -> IO ()) -> Name -> String -> IO () -convertSrc make x src = do +convertSrc :: ([Name] -> IO ()) -> [Name] -> Name -> String -> IO () +convertSrc make deps 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 $ txt x - if not b then - putWarning $ "Warning: " ++ x ++ " couldn't be converted, no input file found" - else do - (deps,src) <- readInput x - make deps - let deps2 = map hoo deps - deps3 <- filterM doesFileExist deps2 - when (deps2 /= deps3) $ putWarning $ "Warning: " ++ x ++ " doesn't know about dependencies on " ++ unwords (deps2 \\ deps3) - dbs <- mapM loadDatabase deps3 - let (err,db) = createDatabase Haskell dbs src - unless (null err) $ outStrLn $ "Skipped " ++ show (length err) ++ " warnings in " ++ x - whenLoud $ outStr $ unlines $ map show err - outStr $ "Converting " ++ x ++ "... " - performGC - saveDatabase (hoo x) db - outStrLn "done" + make deps + convert (map hoo deps) x (hoo x) src -readInput :: Name -> IO ([Name], String) -readInput x = do - src <- readFileUtf8 $ txt x - let (a,b) = span ("@depends " `isPrefixOf`) $ lines src - return (map (drop 9) a, unlines b) - +---- convert a single database +convert :: [FilePath] -> Name -> FilePath -> String -> IO () +convert deps x out src = do + deps2 <- filterM doesFileExist deps + when (deps /= deps2) $ putWarning $ "Warning: " ++ x ++ " doesn't know about dependencies on " ++ unwords (deps \\ deps2) + dbs <- mapM loadDatabase deps2 + let (err,db) = createDatabase Haskell dbs src + unless (null err) $ outStrLn $ "Skipped " ++ show (length err) ++ " warnings in " ++ x + whenLoud $ outStr $ unlines $ map show err + outStr $ "Converting " ++ x ++ "... " + performGC + saveDatabase out db + outStrLn "done" -- combine multiple databases diff --git a/src/Recipe/Hackage.hs b/src/Recipe/Hackage.hs --- a/src/Recipe/Hackage.hs +++ b/src/Recipe/Hackage.hs @@ -4,6 +4,7 @@ import Recipe.Type import Recipe.Cabal import Recipe.General +import Recipe.Haddock import General.Base import General.System import General.Util @@ -43,7 +44,7 @@ Just src -> [""] ++ zipWith (++) ("-- | " : repeat "-- ") (cabalDescription src) ++ ["--","-- Version " ++ ver, "@url package/" ++ name, "@entry package " ++ name] - convertSrc noDeps "package" $ unlines $ + convertSrc noDeps [] "package" $ unlines $ "@url http://hackage.haskell.org/" : "@package package" : concat xs @@ -54,8 +55,10 @@ Left e -> putWarning $ "Warning: Exception when reading haddock for ghc, " ++ show (e :: SomeException) Right had -> do loc <- findLocal local "ghc" - convertSrc make "ghc" $ unlines $ "@depends base" : (f loc) (haddockHacks $ lines had) - where f loc = haddockPackageUrl $ maybe "http://www.haskell.org/ghc/docs/latest/html/libraries/ghc/" id loc + convertSrc make ["base"] "ghc" $ unlines $ "@depends base" : haddockHacks (url loc) (lines had) + where url loc = if isNothing loc + then Just "http://www.haskell.org/ghc/docs/latest/html/libraries/ghc/" + else loc makeDefault make local name = do let base = name == "base" @@ -74,10 +77,10 @@ Left e -> putWarning $ "Warning: Exception when reading haddock for " ++ name ++ ", " ++ show (e :: SomeException) Right had -> do deps <- fmap (maybe [] cabalDepends) $ readCabal cab + let cleanDeps = deps \\ (name:avoid) loc <- findLocal local name - convertSrc make name $ unlines $ - ["@depends " ++ a | a <- deps \\ (name:avoid)] ++ - (maybe id haddockPackageUrl loc) (haddockHacks $ lines had) + convertSrc make cleanDeps name $ unlines $ + ["@depends " ++ a | a <- cleanDeps] ++ haddockHacks loc (lines had) -- try and find a local filepath @@ -107,34 +110,3 @@ where avoid x = ("haskell" `isPrefixOf` x && all isDigit (drop 7 x)) || (x `elem` words "Cabal hpc Win32") - - ---------------------------------------------------------------------- --- HADDOCK HACKS - --- Eliminate @version --- Change :*: to (:*:), Haddock bug --- Change !!Int to !Int, Haddock bug --- Change instance [overlap ok] to instance, Haddock bug --- Change instance [incoherent] to instance, Haddock bug --- Change !Int to Int, HSE bug --- Drop everything after where, Haddock bug - -haddockHacks :: [String] -> [String] -haddockHacks = map (unwords . g . map f . words) . filter (not . isPrefixOf "@version ") - where - f "::" = "::" - f (':':xs) = "(:" ++ xs ++ ")" - f ('!':'!':x:xs) | isAlpha x = xs - f ('!':x:xs) | isAlpha x || x `elem` "[(" = x:xs - f x | x `elem` ["[overlap","ok]","[incoherent]"] = "" - f x = x - - g ("where":xs) = [] - g (x:xs) = x : g xs - g [] = [] - -haddockPackageUrl :: URL -> [String] -> [String] -haddockPackageUrl x = concatMap f - where f y | "@package " `isPrefixOf` y = ["@url " ++ x, y] - | otherwise = [y] diff --git a/src/Recipe/Haddock.hs b/src/Recipe/Haddock.hs --- a/src/Recipe/Haddock.hs +++ b/src/Recipe/Haddock.hs @@ -1,7 +1,7 @@ {-# LANGUAGE PatternGuards #-} module Recipe.Haddock( - haddockToHTML + haddockToHTML, haddockHacks ) where import General.Base @@ -106,3 +106,37 @@ [(R.Ident ys, "")] -> True [(R.Symbol ys, "")] -> True _ -> False + + +--------------------------------------------------------------------- +-- HADDOCK HACKS + +-- Eliminate @version +-- Change :*: to (:*:), Haddock bug +-- Change !!Int to !Int, Haddock bug +-- Change instance [overlap ok] to instance, Haddock bug +-- Change instance [incoherent] to instance, Haddock bug +-- Change !Int to Int, HSE bug +-- Drop everything after where, Haddock bug + +haddockHacks :: Maybe URL -> [String] -> [String] +haddockHacks loc src = maybe id haddockPackageUrl loc (translate src) + where + translate :: [String] -> [String] + translate = map (unwords . g . map f . words) . filter (not . isPrefixOf "@version ") + + f "::" = "::" + f (':':xs) = "(:" ++ xs ++ ")" + f ('!':'!':x:xs) | isAlpha x = xs + f ('!':x:xs) | isAlpha x || x `elem` "[(" = x:xs + f x | x `elem` ["[overlap","ok]","[incoherent]"] = "" + f x = x + + g ("where":xs) = [] + g (x:xs) = x : g xs + g [] = [] + +haddockPackageUrl :: URL -> [String] -> [String] +haddockPackageUrl x = concatMap f + where f y | "@package " `isPrefixOf` y = ["@url " ++ x, y] + | otherwise = [y] diff --git a/src/Recipe/Keyword.hs b/src/Recipe/Keyword.hs --- a/src/Recipe/Keyword.hs +++ b/src/Recipe/Keyword.hs @@ -8,8 +8,7 @@ makeKeyword :: IO () -makeKeyword = do - convertSrc noDeps "keyword" . translate =<< readFileUtf8' keywords +makeKeyword = convertSrc noDeps [] "keyword" . translate =<< readFileUtf8' keywords translate :: String -> String