module Hoogle.DataBase.SubstrSearch
(SubstrSearch, createSubstrSearch
,searchSubstrSearch
,completionsSubstrSearch
) where
import Hoogle.Store.All
import qualified Data.Set as Set
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS
import qualified Data.ByteString.Char8 as BSC
import General.Base
import Data.Array
import Hoogle.Type.All
import Hoogle.Score.All
data SubstrSearch a = SubstrSearch
{text :: BString
,lens :: BString
,inds :: Array Int a
}
deriving Typeable
createSubstrSearch :: [(String,a)] -> SubstrSearch a
createSubstrSearch xs = SubstrSearch
(fromString $ concat ts2)
(BS.pack $ map fromIntegral ls2)
(listArray (0,length is1) is)
where
(ts,is) = unzip $ map (first $ map toLower) xs
(ts2,ls2) = f "" ts
f x (y:ys) = first (y:) $ second (length y:) $ f y ys
f x [] = ([],[])
data S a = S
{sCount :: !Int
,sFocus :: !BS.ByteString
,sPrefix :: ![(a,EntryView,Score)]
,sInfix :: ![(a,EntryView,Score)]
}
searchSubstrSearch :: SubstrSearch a -> String -> [(a, EntryView, Score)]
searchSubstrSearch x y = reverse (sPrefix sN) ++ reverse (sInfix sN)
where
view = FocusOn y
match = bsMatch (BSC.pack $ map toLower y)
sN = BS.foldl f s0 $ lens x
s0 = S 0 (text x) [] []
f s ii = addCount $ moveFocus i $ maybe id addMatch t s
where t = match i $ BS.unsafeTake i $ sFocus s
i = fromIntegral ii
addCount s = s{sCount=sCount s+1}
moveFocus i s = s{sFocus=BS.unsafeDrop i $ sFocus s}
addMatch MatchSubstr s = s{sInfix =(inds x ! sCount s,view,textScore MatchSubstr):sInfix s}
addMatch t s = s{sPrefix=(inds x ! sCount s,view,textScore t):sPrefix s}
data S2 = S2
{_s2Focus :: !BS.ByteString
,s2Result :: Set.Set BS.ByteString
}
completionsSubstrSearch :: SubstrSearch a -> String -> [String]
completionsSubstrSearch x y = map (\x -> y ++ drop ny (BSC.unpack x)) $ take 10 $ Set.toAscList $
s2Result $ BS.foldl f (S2 (text x) Set.empty) $ lens x
where
ny = length y
ly = fromString $ map toLower y
f (S2 foc res) ii = S2 (BS.unsafeDrop i foc) (if ly `BS.isPrefixOf` x then Set.insert x res else res)
where x = BS.unsafeTake i foc
i = fromIntegral ii
instance Show a => Show (SubstrSearch a) where
show x = "SubstrSearch"
instance (Typeable a, Store a) => Store (SubstrSearch a) where
put (SubstrSearch a b c) = putDefer $ put3 a b c
get = getDefer $ get3 SubstrSearch
bsMatch :: BS.ByteString -> Int -> BS.ByteString -> Maybe TextMatch
bsMatch x
| nx == 0 = \ny _ -> Just $ if ny == 0 then MatchExact else MatchPrefix
| nx == 1 = let c = BS.head x in \ny y -> case BS.elemIndex c y of
Nothing -> Nothing
Just 0 -> Just $ if ny == 1 then MatchExact else MatchPrefix
Just _ -> Just MatchSubstr
| otherwise = \ny y -> if BS.isPrefixOf x y then Just (if nx == nx then MatchExact else MatchPrefix)
else if BS.isInfixOf x y then Just MatchSubstr else Nothing
where nx = BS.length x