hoogle-index 0.1 → 0.2
raw patch · 2 files changed
+37/−21 lines, 2 filesdep +temporary
Dependencies added: temporary
Files
- Main.hs +35/−20
- hoogle-index.cabal +2/−1
Main.hs view
@@ -17,6 +17,7 @@ import Control.Error import qualified Data.ByteString.Char8 as BS+import System.IO.Temp import Distribution.Verbosity (Verbosity, normal) import Distribution.Simple.Compiler (Compiler (compilerId), compilerFlavor)@@ -33,16 +34,16 @@ import qualified Distribution.Simple.InstallDirs as IDirs -- | Various configuration-data Config = Config { outputDir :: FilePath- , verbosity :: Verbosity- , installTextBase :: Bool- , useLocalDocs :: Bool+data Config = Config { verbosity :: Verbosity+ , installTextBase :: Bool+ , useLocalDocs :: Bool+ , ignoreExistingTextBases :: Bool } -config = Config { outputDir = "./hoogle-index"- , verbosity = normal- , installTextBase = True- , useLocalDocs = True+config = Config { verbosity = normal+ , installTextBase = True+ , useLocalDocs = True+ , ignoreExistingTextBases = False } -- | An unpacked Cabal project@@ -60,14 +61,17 @@ ExitFailure e -> left $ "Process "++exec++" failed with error "++show e -- | Unpack a package-unpack :: PackageId -> IO PackageTree+unpack :: PackageId -> EitherT String IO PackageTree unpack (PackageIdentifier (PackageName pkg) ver) = do- callProcess "cabal" ["unpack", pkg++"=="++showVersion ver]- return $ PkgTree $ pkg++"-"++showVersion ver+ tmpDir <- liftIO getTemporaryDirectory+ dir <- liftIO $ createTempDirectory tmpDir "hoogle-index.pkg"+ callProcessIn dir "cabal" ["unpack", pkg++"=="++showVersion ver]+ return $ PkgTree $ dir </> pkg++"-"++showVersion ver -- | Remove an unpacked tree removeTree :: PackageTree -> IO ()-removeTree (PkgTree dir) = removeDirectoryRecursive dir+removeTree (PkgTree dir) =+ removeDirectoryRecursive $ takeDirectory dir -- | A Haddock textbase newtype TextBase = TextBase BS.ByteString@@ -103,11 +107,13 @@ getTextBase :: Config -> InstalledPackageInfo -> EitherT String IO TextBase getTextBase cfg ipkg = do- existing <- liftIO $ findTextBase ipkg+ existing <- if ignoreExistingTextBases cfg+ then return Nothing+ else liftIO $ findTextBase ipkg case existing of Just path -> TextBase <$> liftIO (BS.readFile path) Nothing -> do- pkgTree <- fmapLT show $ tryIO $ unpack pkg+ pkgTree <- unpack pkg tb <- buildTextBase (pkgName pkg) pkgTree liftIO $ removeTree pkgTree @@ -127,14 +133,21 @@ newtype Database = DB FilePath deriving (Show) +-- | Delete a database file+removeDB :: Database -> IO ()+removeDB (DB path) = removeFile path+ -- | Convert a textbase to a Hoogle database convert :: TextBaseFile -> Maybe FilePath -> [Database] -> EitherT String IO Database convert tbf docRoot merge = do let docRoot' = maybe [] (\d->["--haddock", "--doc="++d]) docRoot- let args = ["convert", tbf] ++ docRoot'+ (tb,h) <- liftIO $ openTempFile "/tmp" "db.hoo"+ liftIO $ hClose h+ let args = ["convert", tbf, tb] ++ docRoot' ++ map (\(DB db)->"--merge="++db) merge+ fmapLT show $ tryIO $ callProcess "hoogle" args- return $ DB $ replaceExtension tbf ".hoo"+ return $ DB tb -- | Generate a Hoogle database for an installed package indexPackage :: Config -> InstalledPackageInfo -> EitherT String IO Database@@ -142,9 +155,9 @@ let pkg = sourcePackageId ipkg tb <- getTextBase cfg ipkg docRoot <- case haddockHTMLs ipkg of- docRoot:_ | useLocalDocs cfg -> Just docRoot + docRoot:_ | useLocalDocs cfg -> return $ Just docRoot [] | useLocalDocs cfg -> do- putStrLn $ "No local documentation for "++pkg+ liftIO $ putStrLn $ "No local documentation for "++show pkg return Nothing _ -> return Nothing (tbf,h) <- liftIO $ openTempFile "/tmp" "textbase.txt"@@ -157,7 +170,9 @@ -- | Combine Hoogle databases combineDBs :: [Database] -> IO Database combineDBs dbs = do- let out = "all.hoo"+ tmpDir <- getTemporaryDirectory+ (out, h) <- openTempFile tmpDir "combined.hoo"+ hClose h callProcess "hoogle" (["combine", "--outfile="++out] ++ map (\(DB db)->db) dbs) return (DB out) @@ -180,7 +195,6 @@ main :: IO () main = do- createDirectoryIfMissing True (outputDir config) (compiler, _, progCfg) <- configure (verbosity config) Nothing Nothing defaultProgramConfiguration@@ -198,5 +212,6 @@ putStrLn $ unlines $ map failedMsg failed combined <- combineDBs idxs+ --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.1+version: 0.2 synopsis: Easily generate Hoogle indices for installed packages description: Easily generate Hoogle indices for installed packages homepage: http://github.com/bgamari/hoogle-index@@ -26,5 +26,6 @@ filepath >=1.3 && <1.4, errors >=1.4 && <1.5, bytestring >=0.9 && <1.11,+ temporary >=1.2 && <1.3, Cabal >=1.20 && <1.21 default-language: Haskell2010