module Hoogle(
TagStr(..), showTagText, showTagANSI, showTagHTML, showTagHTMLWith,
H.ParseError(..),
URL,
H.Language(..),
Database, loadDatabase, saveDatabase, createDatabase, mergeDatabase, showDatabase,
defaultDatabaseLocation,
Query, parseQuery, H.renderQuery,
H.queryDatabases, H.queryPackages, H.querySetPackage,
Score, H.scoring,
Result(..), search, suggestions, completions, queryExact, H.ItemKind(..)
) where
import Hoogle.Store.All
import General.Base
import General.System
import System.FilePath
import Hoogle.DataBase2.Type
import Hoogle.DataBase2.Str
import System.IO.Unsafe
import Paths_hoogle
import Hoogle.Type.TagStr
import qualified Hoogle.DataBase.All as H
import qualified Hoogle.Query.All as H
import qualified Hoogle.Score.All as H
import qualified Hoogle.Search.All as H
import qualified Hoogle.Type.All as H
import qualified Hoogle.Language.Haskell as H
import Hoogle.Query.All(Query, exactSearch)
import Hoogle.Score.All(Score)
new = False
new2 = False
newtype Database = Database [(FilePath, H.DataBase)]
toDataBase (Database x) = H.combineDataBase $ map snd x
instance NFData Database where
rnf (Database a) = rnf a
instance Monoid Database where
mempty = Database []
mappend (Database xs) (Database ys) = Database $ xs ++ ys
instance Show Database where
show = show . toDataBase
saveDatabase :: FilePath -> Database -> IO ()
saveDatabase file x@(Database xs) = do
performGC
H.saveDataBase file $ toDataBase x
when new $ do
performGC
mergeStr [x <.> "str" | (x,_) <- xs] (file <.> "str")
mergeDatabase :: [FilePath] -> FilePath -> IO ()
mergeDatabase src out = do
x <- mapM loadDatabase src
saveDatabase out $ mconcat x
loadDatabase :: FilePath -> IO Database
loadDatabase x = do db <- H.loadDataBase x; return $ Database [(x, db)]
defaultDatabaseLocation :: IO FilePath
defaultDatabaseLocation = getDataDir
createDatabase
:: H.HackageURL
-> H.Language
-> [Database]
-> String
-> FilePath
-> IO [H.ParseError]
createDatabase url _ dbs src out = do
let (err,res) = H.parseInputHaskell url src
let xs = concat [map snd x | Database x <- dbs]
let db = H.createDataBase xs res
performGC
items <- H.saveDataBase out db
when (new && takeExtension out == ".hoo") $ do
createStr' (newPackage $ takeBaseName out) (map (Pos *** fromOnce) items) (out <.> "str")
when (new2 && takeExtension out == ".hoo") $ do
items <- fmap (map snd) $ H.saveDataBase (dropExtension out <.> "idx.hoo") $ H.createDataBaseEntries res
items <- return $ flip map items $ unsafeFmapOnce $ \e -> e{H.entryLocations = map (first $ const "") $ H.entryLocations e, H.entryName="", H.entryText=mempty, H.entryDocs=mempty}
H.saveDataBase (dropExtension out <.> "str.hoo") $ H.createDataBaseText items
H.saveDataBase (dropExtension out <.> "typ.hoo") $ H.createDataBaseType xs res items
return ()
return err
showDatabase :: Database -> Maybe [String] -> String
showDatabase x sects = concatMap (`H.showDataBase` toDataBase x) $ fromMaybe [""] sects
parseQuery :: H.Language -> String -> Either H.ParseError Query
parseQuery _ = H.parseQuery
data Result = Result
{locations :: [(URL, [(URL, String)])]
,self :: TagStr
,docs :: TagStr
}
deriving (Eq, Show)
toResult :: H.Result -> (Score,Result)
toResult r@(H.Result ent view score) = (score, Result parents self docs)
where
self = H.renderResult r
parents = map (second $ map f) $ H.entryLocations ent
f = (H.entryURL &&& H.entryName) . fromOnce
docs = H.renderDocs $ H.entryDocs ent
search :: Database -> Query -> [(Score,Result)]
search (Database xs@((root,_):_)) (H.Query [name] Nothing scopes Nothing False) | new && all simple scopes =
unsafePerformIO $ map toResult <$> searchStr' resolve (map fst xs) name
where resolve pkg pos = runSGetAt pos (takeDirectory root </> pkg <.> "hoo") get
simple (H.Scope a b _) = a && b == H.Package
search (Database xs) q = map toResult $ H.search (map snd xs) q
suggestions :: Database -> Query -> Maybe TagStr
suggestions (Database dbs) q = H.suggestQuery (map snd dbs) q
completions :: Database -> String -> [String]
completions x = H.completions (toDataBase x)
queryExact :: Maybe H.ItemKind -> Query -> Query
queryExact kind q = q { exactSearch = kind }