hoogle 4.2.27 → 4.2.28

raw patch · 10 files changed

+173/−169 lines, 10 filesdep ~shake

Dependency ranges changed: shake

Files

• CHANGES.txt +3/−0
• docs/LICENSE +1/−1
• hoogle.cabal +3/−4
• src/CmdLine/Type.hs +2/−1
• src/Hoogle/Language/Haskell.hs +2/−0
• src/Recipe/All.hs +135/−114
• src/Recipe/Cabal.hs +13/−17
• src/Recipe/Command.hs +10/−6
• src/Recipe/Haddock.hs +4/−1
• src/Recipe/Warning.hs +0/−25

@@ -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

@@ -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

@@ -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 <ndmitchell@gmail.com> maintainer:         Neil Mitchell <ndmitchell@gmail.com>-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

@@ -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"

@@ -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

@@ -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)

@@ -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]

@@ -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

@@ -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) = []

@@ -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 []