module Text.Search.Sphinx ( Configuration (..)
, query
, defaultConfig
) where
import Network
import IO hiding (bracket)
import System
import Control.Exception
import Data.Binary.Get
import Data.Binary.Put (runPut, Put)
import Data.ByteString.Lazy hiding (pack, length, map, groupBy, head)
import Data.ByteString.Lazy.Char8 (pack)
import qualified Data.ByteString.Lazy as BS
import Data.Char (ord, chr)
import Data.Int (Int64)
import Prelude hiding (readList)
import Text.Search.Sphinx.Get
import Text.Search.Sphinx.Put
import Text.Search.Sphinx.Configuration
import Text.Search.Sphinx.Types (SearchResult)
import qualified Text.Search.Sphinx.Types as T
type Connection = (Handle, Configuration)
connect :: Configuration -> IO Connection
connect cfg = do connection <- connectTo (host cfg) (PortNumber $ fromIntegral $ port cfg)
bs <- hGet connection 4
let version = runGet getWord32be bs
myVersion = runPut (num 1)
hPut connection myVersion
return (connection, cfg)
addQuery :: Configuration -> String -> String -> String -> Put
addQuery cfg query index comment = do
nums cfg [ offset
, limit
, T.matchMode . mode
, T.rank . ranker
, T.sort . sort]
str (sortBy cfg)
str query
numList (weights cfg)
str index
num 1
num64s cfg [minId, maxId]
num 0
enum (groupByFunc cfg)
str (groupBy cfg)
num (maxMatches cfg)
str (groupSort cfg)
num (cutoff cfg)
num (retryCount cfg)
num (retryDelay cfg)
str (groupDistinct cfg)
num 0
stringIntList (indexWeights cfg)
num (maxQueryTime cfg)
stringIntList (fieldWeights cfg)
str comment
query :: Configuration
-> String
-> String
-> IO SearchResult
query config indexes s = do
conn <- connect config
let q = addQuery config s indexes ""
results <- runQueries (fst conn) q 1
return $ head results
runQueries :: Handle -> Put -> Int -> IO [SearchResult]
runQueries conn q numQueries = do
let req = runPut (makeRunQuery q numQueries)
hPut conn req
hFlush conn
getResponse conn numQueries
makeRunQuery query numQueries = do
cmd T.ScSearch
verCmd T.VcSearch
num $ fromEnum $ BS.length (runPut query) + 4
num numQueries
query
getResponse conn numResults = do
header <- hGet conn 8
let x@(status, version, len) = readHeader header
response <- hGet conn (fromIntegral len)
return $ runGet (numResults `times` getResult) response