module Hoogle(
TagStr(..), showTagText, showTagANSI, showTagHTML, showTagHTMLWith,
H.ParseError(..),
URL,
H.Language(..),
Database, loadDatabase, saveDatabase, createDatabase, mergeDatabase, showDatabase,
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 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)]
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 }