hoogle-index 0.2.2 → 0.3.0
raw patch · 2 files changed
+49/−15 lines, 2 filesdep +containers
Dependencies added: containers
Files
- Main.hs +47/−14
- hoogle-index.cabal +2/−1
Main.hs view
@@ -13,6 +13,8 @@ import System.FilePath import System.IO +import qualified Data.Set as S+ import Data.Either (partitionEithers) import Control.Error @@ -69,7 +71,11 @@ newtype PackageTree = PkgTree FilePath deriving (Show) --- | Call a package from the given directory+-- | Call a process+callProcessE :: FilePath -> [String] -> EitherT String IO ()+callProcessE exec args = fmapLT show $ tryIO $ callProcess exec args++-- | Call a process from the given directory callProcessIn :: FilePath -> FilePath -> [String] -> EitherT String IO () callProcessIn dir exec args = do let cp = (proc exec args) { cwd = Just dir }@@ -120,7 +126,7 @@ buildTextBase :: PackageName -> PackageTree -> EitherT String IO TextBase buildTextBase (PackageName pkg) (PkgTree dir) = do callProcessIn dir "cabal" ["configure"]- callProcessIn dir "runghc" ["Setup", "haddock", "--hoogle"]+ callProcessIn dir "cabal" ["haddock", "--hoogle"] let path = dir </> "dist" </> "doc" </> "html" </> pkg </> (pkg++".txt") TextBase <$> liftIO (BS.readFile path) @@ -138,12 +144,13 @@ -- install textbase if necessary case listToMaybe $ haddockHTMLs ipkg of- Just docRoot | installTextBase cfg -> do+ Just docRoot | installTextBase cfg -> fmapLT show $ tryIO $ do let TextBase content = tb PackageName name = pkgName $ sourcePackageId ipkg tbPath = docRoot </> name++".txt"- liftIO $ putStrLn $ "Installing textbase to "++tbPath- liftIO $ BS.writeFile tbPath content+ putStrLn $ "Installing textbase to "++tbPath+ createDirectoryIfMissing True docRoot+ BS.writeFile tbPath content Nothing | installTextBase cfg -> do liftIO $ putStrLn $ "Can't install textbase due to missing documentation directory" _ -> return ()@@ -173,8 +180,16 @@ -- | Generate a Hoogle database for an installed package indexPackage :: Config -> InstalledPackageInfo -> EitherT String IO Database-indexPackage cfg ipkg = do- let pkg = sourcePackageId ipkg+indexPackage cfg ipkg+ | pkgName pkg `S.member` downloadPackages = do+ tmpDir <- liftIO getTemporaryDirectory+ callProcessE "hoogle" ["data", "--datadir="++tmpDir, name]+ return $ DB $ tmpDir </> name++".hoo"++ | pkgName pkg `S.member` ignorePackages =+ left $ "Can't build documentation for "++name++ | otherwise = do tb <- getTextBase cfg ipkg docRoot <- case haddockHTMLs ipkg of docRoot:_ | useLocalDocs cfg -> return $ Just docRoot@@ -188,10 +203,17 @@ db <- convert tbf docRoot [] liftIO $ removeFile tbf return db+ where+ downloadPackages = S.fromList $ map PackageName+ ["base"]+ ignorePackages = S.fromList $ map PackageName+ ["rts", "ghc-prim", "integer-gmp"]+ pkg = sourcePackageId ipkg+ PackageName name = pkgName pkg -- | Combine Hoogle databases-combineDBs :: [Database] -> IO Database-combineDBs dbs = do+combineDBs :: [Database] -> EitherT String IO Database+combineDBs dbs = fmapLT show $ tryIO $ do tmpDir <- getTemporaryDirectory (out, h) <- openTempFile tmpDir "combined.hoo" hClose h@@ -231,8 +253,16 @@ pkgIdx <- getInstalledPackages (verbosity config) pkgDbs progCfg let pkgs = reverseTopologicalOrder pkgIdx maybeIndex :: InstalledPackageInfo -> IO (Either (PackageId, String) Database)- maybeIndex pkg = runEitherT $ fmapLT (sourcePackageId pkg,)- $ indexPackage config pkg+ maybeIndex pkg = do+ putStrLn ""+ result <- runEitherT $ indexPackage config pkg+ case result of+ Left e -> do+ let pkgId = sourcePackageId pkg+ PackageName name = pkgName pkgId+ putStrLn $ "Error while indexing "++name++": "++e+ return $ Left (pkgId, e)+ Right r -> return $ Right r (failed, idxs) <- fmap partitionEithers $ mapM maybeIndex pkgs when (not $ null failed) $ do@@ -240,7 +270,10 @@ let failedMsg (pkgId, reason) = " "++show (pkgName pkgId)++"\t"++reason putStrLn $ unlines $ map failedMsg failed - combined <- combineDBs idxs+ combined <- runEitherT (combineDBs idxs)+ case combined of+ Left e -> putStrLn $ "Error while combining databases: "++e+ Right db -> do+ res <- runEitherT $ installDB compiler pkgIdx db+ either print (const $ return ()) res mapM_ removeDB idxs- res <- runEitherT $ installDB compiler pkgIdx combined- either print (const $ return ()) res
hoogle-index.cabal view
@@ -1,5 +1,5 @@ name: hoogle-index-version: 0.2.2+version: 0.3.0 synopsis: Easily generate Hoogle indices for installed packages description: Easily generate Hoogle indices for installed packages homepage: http://github.com/bgamari/hoogle-index@@ -28,5 +28,6 @@ bytestring >=0.9 && <1.11, temporary >=1.2 && <1.3, Cabal >=1.20 && <1.21,+ containers >=0.4 && <0.6, optparse-applicative >=0.10 && <0.11 default-language: Haskell2010