hoogle 4.2.22 → 4.2.23
raw patch · 9 files changed
+98/−86 lines, 9 files
Files
- hoogle.cabal +1/−1
- src/CmdLine/All.hs +6/−2
- src/CmdLine/Type.hs +5/−2
- src/Console/All.hs +23/−9
- src/Recipe/Download.hs +1/−1
- src/Recipe/General.hs +17/−31
- src/Recipe/Hackage.hs +9/−37
- src/Recipe/Haddock.hs +35/−1
- src/Recipe/Keyword.hs +1/−2
hoogle.cabal view
@@ -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
src/CmdLine/All.hs view
@@ -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
src/CmdLine/Type.hs view
@@ -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" ]
src/Console/All.hs view
@@ -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"
src/Recipe/Download.hs view
@@ -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") ""
src/Recipe/General.hs view
@@ -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
src/Recipe/Hackage.hs view
@@ -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]
src/Recipe/Haddock.hs view
@@ -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]
src/Recipe/Keyword.hs view
@@ -8,8 +8,7 @@ makeKeyword :: IO ()-makeKeyword = do- convertSrc noDeps "keyword" . translate =<< readFileUtf8' keywords+makeKeyword = convertSrc noDeps [] "keyword" . translate =<< readFileUtf8' keywords translate :: String -> String