module Hoogle.DataBase2.Str(
createStr', searchStr',
createStr, mergeStr, searchStr
) where
import General.Base
import Hoogle.DataBase2.Type
import Hoogle.Type.All
import Hoogle.Score.All
import General.Util
import Data.Binary
import System.IO.Unsafe
import System.FilePath
import qualified General.FMIndex as FM
import qualified Data.ByteString.Char8 as BS
data Strs = Strs
{posMaximum :: Pos
,posOffset :: [(Package, Pos)]
,fmIndex :: FM.FMIndex Pos
} deriving Show
posResolve :: Strs -> Pos -> (Package, Pos)
posResolve Strs{..} p = f posOffset
where
f [(pkg,off)] = (pkg,poff)
f ((p1,o1):(p2,o2):rest)
| p < o2 = (p1,po1)
| otherwise = f $ (p2,o2):rest
instance Binary Strs where
put (Strs a b c) = put a >> put b >> put c
get = Strs <$> get <*> get <*> get
saveStr :: FilePath -> Strs -> IO ()
saveStr = encodeFile
loadStr :: FilePath -> IO Strs
loadStr = decodeFile
createStr :: Package -> [(Pos, BS.ByteString)] -> FilePath -> IO ()
createStr pkg items file = saveStr file $ Strs (maximum $ 0 : map fst items) [(pkg, 0)] $ FM.create '\0' $ map ((BS.map toLower . snd) &&& fst) items
mergeStr :: [FilePath] -> FilePath -> IO ()
mergeStr xs file = do
let f mx Strs{..} = (mx + posMaximum, Strs 0 (map (second (+mx)) posOffset) (fmap (+mx) fmIndex))
(mx,xs) <- mapAccumL f 0 <$> mapM loadStr xs
saveStr file $ Strs mx (concatMap posOffset xs) (FM.create '\0' $ concatMap (FM.extract . fmIndex) xs)
searchStr :: [FilePath] -> BS.ByteString -> IO [(Package, Pos, [EntryView], Score)]
searchStr files x = do
files <- mapM loadStr files
let locate (how1,how2) =
[ ((pkg,pos),(pkg,pos,[FocusOn $ BS.unpack x],textScore how2))
| file <- files
, ((pkg,pos),_) <- map (first $ posResolve file) $ FM.locate (fmIndex file) how1 $ BS.map toLower x]
return $ map snd $ nubOrdOn fst $ concatMap locate [(FM.Exact,MatchExact), (FM.Prefix,MatchPrefix), (FM.Infix,MatchSubstr)]
createStr' :: Package -> [(Pos, Entry)] -> FilePath -> IO ()
createStr' pkg items out = createStr pkg (mapMaybe f items) out
where f (pos, Entry{..}) = if null entryKey then Nothing else Just (pos, BS.pack entryKey)
searchStr' :: (String -> Word32 -> IO Entry) -> [FilePath] -> String -> IO [Result]
searchStr' resolve files x = do
res <- searchStr (map (<.> "str") files) $ BS.pack x
return $ flip map res $ \(Package a,Pos b,c,d) -> Result (unsafePerformIO $ resolve (BS.unpack a) b) c d