diff --git a/CHANGES.txt b/CHANGES.txt --- a/CHANGES.txt +++ b/CHANGES.txt @@ -1,5 +1,8 @@ Changelog for Hoogle +4.2.28 + Upgrade to shake-0.11 + #49, update "hoogle data" to be incremental 4.2.27 Rewrite how "hoogle data" works #45, if you are building all, also depend on default diff --git a/docs/LICENSE b/docs/LICENSE --- a/docs/LICENSE +++ b/docs/LICENSE @@ -1,4 +1,4 @@ -Copyright Neil Mitchell 2004-2013. +Copyright Neil Mitchell 2004-2014. All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/hoogle.cabal b/hoogle.cabal --- a/hoogle.cabal +++ b/hoogle.cabal @@ -1,13 +1,13 @@ cabal-version: >= 1.10 build-type: Simple name: hoogle -version: 4.2.27 +version: 4.2.28 license: BSD3 license-file: docs/LICENSE category: Development author: Neil Mitchell maintainer: Neil Mitchell -copyright: Neil Mitchell 2004-2013 +copyright: Neil Mitchell 2004-2014 synopsis: Haskell API Search description: Hoogle is a Haskell API search engine, which allows you to @@ -139,7 +139,7 @@ wai >= 1.1, warp >= 1.1, Cabal >= 1.8, - shake >= 0.10.7, + shake >= 0.11, haskell-src-exts >= 1.14 && < 1.15 if !os(mingw32) @@ -161,7 +161,6 @@ Recipe.Hackage Recipe.Haddock Recipe.Keyword - Recipe.Warning Test.All Test.Docs Test.General diff --git a/src/CmdLine/Type.hs b/src/CmdLine/Type.hs --- a/src/CmdLine/Type.hs +++ b/src/CmdLine/Type.hs @@ -32,7 +32,7 @@ ,queryParsed :: Either ParseError Query ,queryText :: String } - | Data {redownload :: Bool, local :: [String], datadir :: FilePath, threads :: Int, actions :: [String]} + | Data {redownload :: Bool, rebuild :: 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, doc :: Maybe String, merge :: [String], haddock :: Bool} @@ -102,6 +102,7 @@ data_ = Data {datadir = def &= typDir &= help "Database directory" ,redownload = def &= help "Redownload all files from the web" + ,rebuild = def &= help "Rebuild everything" ,threads = 1 &= typ "INT" &= name "j" &= help "Number of threads to use" ,actions = def &= args &= typ "RULE" ,local = def &= opt "" &= typ "FILEPATH" &= help "Use local documentation if available" 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 @@ -138,6 +138,8 @@ ctorStart x = isUpper x || x `elem` ":(" kind | ctorStart $ head nam = DataCtorItem | otherwise = FunctionItem +transDecl x (HSE.TypeSig o names tyy) = fmap f $ sequence [transDecl x $ HSE.TypeSig o [name] tyy | name <- names] + where f xs = (concatMap fst xs, concatMap snd xs) transDecl x (ClassDecl s ctxt hd _ _) = Just $ fact (kinds True $ transDeclHead ctxt hd) $ textItem {itemName=nam, itemKey=nam, itemKind=ClassItem diff --git a/src/Recipe/All.hs b/src/Recipe/All.hs --- a/src/Recipe/All.hs +++ b/src/Recipe/All.hs @@ -1,16 +1,18 @@ -{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-} +{-# LANGUAGE RecordWildCards, ScopedTypeVariables, DeriveDataTypeable, GeneralizedNewtypeDeriving #-} module Recipe.All(recipes) where import General.Base hiding (readFile') import General.System as Sys +import Control.Concurrent import Control.Exception as E +import qualified Data.Map as Map import qualified Data.Set as Set import Development.Shake +import Development.Shake.Classes import Development.Shake.FilePath import Recipe.Haddock -import Recipe.Warning import Recipe.Command import Recipe.Keyword import Recipe.Hackage @@ -27,145 +29,164 @@ hSetBuffering stdout NoBuffering createDirectoryIfMissing True datadir withDirectory datadir $ do - resetWarnings when redownload $ do forM_ urls $ \(file,_) -> removeFile_ $ "downloads" file - shake shakeOptions{shakeVersion=showVersion V.version, shakeThreads=threads, shakeProgress=progressSimple} $ do - want $ map (<.> "hoo") $ if null actions then ["default"] else actions - rules opt - recapWarnings + when rebuild $ removeFile ".shake.database" + (count, file) <- withWarnings $ \warn -> + shake shakeOptions{shakeVersion=showVersion V.version, shakeThreads=threads, shakeProgress=progressSimple} $ do + want $ map (<.> "hoo") $ if null actions then ["default"] else actions + rules opt warn + putStrLn $ show count ++ " warnings, saved to " ++ file putStrLn "Data generation complete" -rules :: CmdLine -> Rules () -rules Data{..} = do - "downloads/packages.txt" *> \out -> do - need ["downloads/hoogle.untar","downloads/cabal.untar"] - as <- liftIO $ listing "downloads/hoogle" - bs <- liftIO $ listing "downloads/cabal" - writeFileLines out $ Set.toList $ Set.fromList as `Set.intersection` Set.fromList bs +newtype CabalVersion = CabalVersion String deriving (Show,Typeable,Eq,Hashable,Binary,NFData) +newtype HoogleVersion = HoogleVersion String deriving (Show,Typeable,Eq,Hashable,Binary,NFData) - packages <- do - cache <- newCache $ fmap (Set.fromList . lines) . readFile - return $ cache "downloads/packages.txt" +rules :: CmdLine -> ([String] -> IO ()) -> Rules () +rules Data{..} warn = do + let srcCabal name ver = "downloads/cabal" name ver name <.> "cabal" + let srcHoogle name ver = "downloads/hoogle" name ver "doc" "html" name <.> "txt" - phony "all.hoo" $ do - pkgs <- packages - need $ map (<.> "hoo") $ "default" : Set.toList pkgs + (\x -> "downloads/*" ?== x && isJust (lookup (takeFileName x) urls)) ?> \out -> do + let Just url = lookup (takeFileName out) urls + putNormal $ "Downloading " ++ out + -- liftIO $ copyFile ("C:/spacework/hoogle/cache" takeFileName out) out + wget url out + putNormal $ "Downloaded " ++ out - "keyword.txt" *> \out -> do - let src = "downloads/keyword.htm" + "downloads/*.cache" *> \out -> do + let src = dropExtension out need [src] - contents <- liftIO $ readFileUtf8' src - liftIO $ writeFileUtf8 out $ translateKeywords contents + src <- liftIO $ readFileUtf8' src + b <- liftIO $ Sys.doesFileExist out + liftIO $ if not b then writeFileUtf8 out src else do + old <- readFileUtf8' out + when (src /= old) $ writeFileUtf8 out src - "default.txt" *> \out -> do - writeFileLines out ["@combine keyword","@combine package","@combine platform"] + "//*.tar" *> \out -> do + let src = out <.> "gz" + need [src] + ungzip src out - "platform.txt" *> \out -> do - let src = "downloads/platform.cabal" - contents <- readFile' src - writeFileLines out ["@combine " ++ x | x <- platformPackages contents] + "//*.index" *> \out -> do + let src = out -<.> "tar" + need [src] + putNormal $ "Extracting tar file " ++ out + tarExtract src + putNormal $ "Finished extracting tar file " ++ out + writeFileChanged out . unlines =<< tarList src - "package.txt" *> \out -> do - need ["downloads/cabal.untar"] - xs <- liftIO $ listing "downloads/cabal" - xs <- liftIO $ forM xs $ \name -> do - ver <- version "downloads/cabal" name - let file = "downloads/cabal" name ver name <.> "cabal" - src <- readCabal file - return $ case src of - Nothing -> [] - Just src -> - [""] ++ zipWith (++) ("-- | " : repeat "-- ") (cabalDescription src) ++ - ["--","-- Version " ++ ver, "@url package/" ++ name, "@entry package " ++ name] - liftIO $ writeFileUtf8 out $ unlines $ "@url http://hackage.haskell.org/" : "@package package" : concat xs + index <- newCache $ \index -> do + xs <- readFileLines index + let asVer = map (read :: String -> Int) . words . map (\x -> if x == '.' then ' ' else x) + return $ Map.fromListWith (\a b -> if asVer a > asVer b then a else b) + [(name, ver) | x <- xs, let name = takeDirectory1 x, let ver = takeDirectory1 $ dropDirectory1 x, all (\x -> isDigit x || x == '.') ver] - (\x -> "*.txt" ?== x && takeBaseName x `notElem` ["keyword","default","platform","package"]) ?> \out -> do - need ["downloads/hoogle.untar","downloads/cabal.untar"] - let name = takeBaseName out - base = name == "base" - vc <- liftIO $ version "downloads/cabal" name - vh <- liftIO $ if base then return vc else version "downloads/hoogle" name - let hoo = if base then "downloads/base.txt" else "downloads/hoogle" name vh "doc" "html" name <.> "txt" - cab = "downloads/cabal" name vc name <.> "cabal" - need [hoo, cab] - hoo <- liftIO $ readFileUtf8' hoo `E.catch` \(_ :: SomeException) -> readFile hoo - deps <- liftIO $ fmap (maybe [] cabalDepends) $ readCabal cab - let cleanDeps = deps \\ (name:avoid) - loc <- liftIO $ findLocal local name - liftIO $ writeFileUtf8 out $ unlines $ - ["@depends " ++ a | a <- cleanDeps] ++ haddockHacks loc (lines hoo) + verCabal <- addOracle $ \(CabalVersion x) -> fmap (Map.lookup x) $ index "downloads/cabal.index" + verHoogle <- addOracle $ \(HoogleVersion x) -> fmap (Map.lookup x) $ index "downloads/hoogle.index" - imported <- newCache $ \file -> do - xs <- readFileUtf8' file - return [x | x <- lines xs, takeWhile (not . isSpace) x `elem` ["type","data","newtype","class","instance","@depends"]] - let listDeps = map (drop 9) . takeWhile ("@depends " `isPrefixOf`) + alternatives $ do -- Match *.txt + "keyword.txt" *> \out -> do + let src = "downloads/keyword.htm.cache" + need [src] + contents <- liftIO $ readFileUtf8' src + liftIO $ writeFileUtf8 out $ translateKeywords contents - let genImported pkgs seen [] = return [] - genImported pkgs seen (t:odo) - | t `Set.member` seen || not (t `Set.member` pkgs) = genImported pkgs seen odo - | otherwise = do - i <- imported $ t <.> "txt" - let deps = listDeps i - fmap (i++) $ genImported pkgs (Set.insert t seen) (deps++odo) + "default.txt" *> \out -> do + writeFileLines out ["@combine keyword","@combine package","@combine platform"] - (\x -> "*.hoo" ?== x && x /= "all.hoo") ?> \out -> do - let src = out -<.> "txt" - need [src] - contents <- liftIO $ fmap lines $ readFileUtf8' src - if not (null contents) && "@combine " `isPrefixOf` head contents then do - let deps = [x <.> "hoo" | x <- contents, Just x <- [stripPrefix "@combine " x]] - need deps - dbs <- liftIO $ mapM loadDatabase deps - putNormal $ "Creating " ++ out ++ " from " ++ show (length deps) ++ " databases... " - liftIO $ performGC - liftIO $ saveDatabase out $ mconcat dbs - else do - pkgs <- packages - deps <- genImported pkgs (Set.singleton $ takeBaseName out) $ listDeps contents - let (err,db) = createDatabase Haskell [snd $ createDatabase Haskell [] $ unlines deps] $ unlines contents - unless (null err) $ putNormal $ "Skipped " ++ show (length err) ++ " warnings in " ++ out - putLoud $ unlines $ map show err - putNormal $ "Creating " ++ out ++ "... " - liftIO $ performGC - liftIO $ saveDatabase out db + "platform.txt" *> \out -> do + contents <- readFile' "downloads/platform.cabal.cache" + writeFileLines out ["@combine " ++ x | x <- platformPackages contents] - "//*.tar" *> \out -> do - let src = out <.> "gz" - need [src] - ungzip src out + "package.txt" *> \out -> do + cabs <- index "downloads/cabal.index" + xs <- liftIO $ forM (Map.toList cabs) $ \(name,ver) -> do + src <- try $ readCabal $ srcCabal name ver + return $ case src of + Left (_ :: SomeException) -> [] + Right src -> + [""] ++ zipWith (++) ("-- | " : repeat "-- ") (cabalDescription src) ++ + ["--","-- Version " ++ ver, "@url package/" ++ name, "@entry package " ++ name] + liftIO $ writeFileUtf8 out $ unlines $ "@url http://hackage.haskell.org/" : "@package package" : concat xs - "//*.untar" *> \out -> do - let src = out -<.> "tar" - need [src] - untar src - writeFile' out "" + "*.txt" *> \out -> do + let name = takeBaseName out + base = name == "base" + cab <- fmap (fmap $ srcCabal name) $ verCabal (CabalVersion name) + hoo <- if base + then need ["downloads/base.txt.cache"] >> return (Just "downloads/base.txt.cache") + else fmap (fmap $ srcHoogle name) $ verHoogle (HoogleVersion name) + hoo <- return $ fromMaybe (error $ "Couldn't find hoogle file for " ++ name) hoo + hoo <- liftIO $ readFileUtf8' hoo `E.catch` \(_ :: SomeException) -> readFile hoo + deps <- liftIO $ case cab of + Nothing -> return [] + Just cab -> do + res <- try $ readCabal cab + case res of + Left (err :: SomeException) -> do warn [takeBaseName cab ++ ": failed to read cabal file, " ++ cab ++ ", " ++ show err]; return [] + Right x -> return $ cabalDepends x + let cleanDeps = deps \\ (name:avoid) + loc <- liftIO $ findLocal local name + liftIO $ writeFileUtf8 out $ unlines $ + ["@depends " ++ a | a <- cleanDeps] ++ haddockHacks loc (lines hoo) - (\x -> "downloads/*" ?== x && isJust (lookup (takeFileName x) urls)) ?> \out -> do - let Just url = lookup (takeFileName out) urls - -- liftIO $ copyFile ("C:/spacework/hoogle/cache" takeFileName out) out - wget url out + alternatives $ do -- Match *.hoo + phony "all.hoo" $ do + pkgs <- index "downloads/hoogle.index" + need $ map (<.> "hoo") $ "default" : Map.keys pkgs + imported <- newCache $ \file -> do + need [file] + xs <- liftIO $ readFileUtf8' file + return [x | x <- lines xs, takeWhile (not . isSpace) x `elem` ["type","data","newtype","class","instance","@depends"]] + let splitDeps = first (map $ drop 9) . span ("@depends " `isPrefixOf`) + let genImported seen [] = return [] + genImported seen (t:odo) = do + v <- if t `Set.member` seen then return Nothing else verHoogle $ HoogleVersion t + if isNothing v then genImported seen odo else do + i <- imported $ t <.> "txt" + fmap (i++) $ genImported (Set.insert t seen) (fst (splitDeps i) ++ odo) + + "*.hoo" *> \out -> do + let src = out -<.> "txt" + need [src] + contents <- liftIO $ fmap lines $ readFileUtf8' src + if not (null contents) && "@combine " `isPrefixOf` head contents then do + let deps = [x <.> "hoo" | x <- contents, Just x <- [stripPrefix "@combine " x]] + need deps + dbs <- liftIO $ mapM loadDatabase deps + putNormal $ "Creating " ++ out ++ " from " ++ show (length deps) ++ " databases... " + liftIO $ performGC + liftIO $ saveDatabase out $ mconcat dbs + else do + (deps, contents) <- return $ splitDeps contents + deps <- genImported (Set.singleton $ takeBaseName out) deps + let (err,db) = createDatabase Haskell [snd $ createDatabase Haskell [] $ unlines deps] $ unlines contents + liftIO $ warn [takeBaseName out ++ ": " ++ show e | e <- err] + putNormal $ "Creating " ++ out ++ "... " + liftIO $ performGC + liftIO $ saveDatabase out db + + urls :: [(FilePath, URL)] urls = let (*) = (,) in ["keyword.htm" * "http://www.haskell.org/haskellwiki/Keywords" ,"platform.cabal" * "http://code.galois.com/darcs/haskell-platform/haskell-platform.cabal" ,"base.txt" * "http://www.haskell.org/hoogle/base.txt" - ,"ghc.txt" * "http://www.haskell.org/ghc/docs/latest/html/libraries/ghc/ghc.txt" ,"cabal.tar.gz" * "http://hackage.haskell.org/packages/index.tar.gz" ,"hoogle.tar.gz" * "http://hackage.haskell.org/packages/hoogle.tar.gz"] -listing :: FilePath -> IO [String] -listing dir = do - xs <- Sys.getDirectoryContents dir - return $ sortBy (comparing $ map toLower) $ filter (`notElem` [".","..","preferred-versions"]) xs - -version :: FilePath -> String -> IO String -version dir x = do - ys <- Sys.getDirectoryContents $ dir x - when (null ys) $ error $ "Couldn't find version for " ++ x ++ " in " ++ dir - let f = map (read :: String -> Int) . words . map (\x -> if x == '.' then ' ' else x) - return $ maximumBy (comparing f) $ filter (all (not . isAlpha)) ys +withWarnings :: (([String] -> IO ()) -> IO ()) -> IO (Int, FilePath) +withWarnings act = do + count <- newMVar 0 + let file = ".warnings" + writeFile file "" + act $ \xs -> unless (null xs) $ modifyMVar_ count $ \i -> do + appendFile file $ unlines xs + return $! i + length xs + i <- readMVar count + return (i, file) diff --git a/src/Recipe/Cabal.hs b/src/Recipe/Cabal.hs --- a/src/Recipe/Cabal.hs +++ b/src/Recipe/Cabal.hs @@ -13,8 +13,6 @@ import Distribution.Verbosity import Distribution.Version import Recipe.Haddock -import Recipe.Warning -import Control.Exception ghcVersion = [7,6,3] @@ -27,18 +25,16 @@ } deriving Show -readCabal :: FilePath -> IO (Maybe Cabal) -readCabal file = handle (\e -> do - putWarning $ "Failure when reading " ++ file ++ ", " ++ show (e :: SomeException) - return Nothing) $ fmap Just $ do - pkg <- readPackageDescription silent file - let plat = Platform I386 Linux - comp = CompilerId GHC (Version ghcVersion []) - pkg <- return $ case finalizePackageDescription [] (const True) plat comp [] pkg of - Left _ -> flattenPackageDescription pkg - Right (pkg,_) -> pkg - return $ Cabal - (display $ pkgName $ package pkg) - (display $ pkgVersion $ package pkg) - (haddockToHTML $ description pkg) - [display x | Just l <- [library pkg], Dependency x _ <- targetBuildDepends $ libBuildInfo l] +readCabal :: FilePath -> IO Cabal +readCabal file = do + pkg <- readPackageDescription silent file + let plat = Platform I386 Linux + comp = CompilerId GHC (Version ghcVersion []) + pkg <- return $ case finalizePackageDescription [] (const True) plat comp [] pkg of + Left _ -> flattenPackageDescription pkg + Right (pkg,_) -> pkg + return $ Cabal + (display $ pkgName $ package pkg) + (display $ pkgVersion $ package pkg) + (haddockToHTML $ description pkg) + [display x | Just l <- [library pkg], Dependency x _ <- targetBuildDepends $ libBuildInfo l] diff --git a/src/Recipe/Command.hs b/src/Recipe/Command.hs --- a/src/Recipe/Command.hs +++ b/src/Recipe/Command.hs @@ -1,10 +1,10 @@ -module Recipe.Command(wget, ungzip, untar) where +module Recipe.Command(wget, ungzip, tarExtract, tarList) where import General.Base import General.System -import System.FilePath -import Development.Shake(Action, command, CmdOption(..), liftIO) +import Development.Shake +import Development.Shake.FilePath wget :: URL -> FilePath -> Action () @@ -19,14 +19,18 @@ when (isNothing hasGzip) $ error "Could not extract tarballs, could not find tar on the $PATH." command [Shell] ("gzip --decompress --stdout --force " ++ from ++ " > " ++ to) [] -untar :: FilePath -> Action () -untar from = do +tarExtract :: FilePath -> Action () +tarExtract from = do hasTar <- liftIO $ check "tar" when (isNothing hasTar) $ error "Could not extract tarballs, could not find tar on the $PATH." liftIO $ createDirectoryIfMissing True $ dropExtension from command [Shell, Cwd $ dropExtension from] ("tar -xf ../" ++ takeFileName from) [] - +tarList :: FilePath -> Action [String] +tarList from = do + hasTar <- liftIO $ check "tar" + when (isNothing hasTar) $ error "Could not extract tarballs, could not find tar on the $PATH." + fmap (lines . fromStdout) $ command [Shell] ("tar -tf " ++ from) [] type Downloader = FilePath -> URL -> String diff --git a/src/Recipe/Haddock.hs b/src/Recipe/Haddock.hs --- a/src/Recipe/Haddock.hs +++ b/src/Recipe/Haddock.hs @@ -116,7 +116,9 @@ -- Change !!Int to !Int, Haddock bug -- Change instance [overlap ok] to instance, Haddock bug -- Change instance [incoherent] to instance, Haddock bug +-- Change instance [safe] to instance, Haddock bug -- Change !Int to Int, HSE bug +-- Drop {-# UNPACK #-}, Haddock bug -- Drop everything after where, Haddock bug haddockHacks :: Maybe URL -> [String] -> [String] @@ -129,7 +131,8 @@ 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 `elem` ["[overlap","ok]","[incoherent]","[safe]"] = "" + f x | x `elem` ["{-#","UNPACK","#-}"] = "" f x = x g ("where":xs) = [] diff --git a/src/Recipe/Warning.hs b/src/Recipe/Warning.hs deleted file mode 100644 --- a/src/Recipe/Warning.hs +++ /dev/null @@ -1,25 +0,0 @@ - -module Recipe.Warning( - resetWarnings, putWarning, recapWarnings - ) where - -import Control.Concurrent -import System.IO.Unsafe - - -{-# NOINLINE warnings #-} -warnings :: MVar [String] -warnings = unsafePerformIO $ newMVar [] - -putWarning :: String -> IO () -putWarning x = do - putStrLn x - modifyMVar_ warnings $ return . (x:) - -recapWarnings :: IO () -recapWarnings = do - xs <- readMVar warnings - mapM_ putStrLn $ reverse xs - -resetWarnings :: IO () -resetWarnings = modifyMVar_ warnings $ const $ return []